View.st
author claus
Sun, 26 Mar 1995 22:14:10 +0200
changeset 125 d74e6ab7157a
parent 123 9f8c7f20fdb2
child 129 752fbb07635a
permissions -rw-r--r--
*** empty log message ***
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
0
48194c26a46c Initial revision
claus
parents:
diff changeset
     1
"
6
7ee0cfde237d *** empty log message ***
claus
parents: 5
diff changeset
     2
 COPYRIGHT (c) 1989 by Claus Gittinger
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
     3
	      All Rights Reserved
0
48194c26a46c Initial revision
claus
parents:
diff changeset
     4
48194c26a46c Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
48194c26a46c Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
48194c26a46c Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
48194c26a46c Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
48194c26a46c Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
48194c26a46c Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
48194c26a46c Initial revision
claus
parents:
diff changeset
    11
"
48194c26a46c Initial revision
claus
parents:
diff changeset
    12
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
    13
'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:02:34 am'!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
    14
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    15
PseudoView subclass:#View
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
    16
	 instanceVariableNames:'superView subViews components style resources viewport
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
    17
		borderColor borderWidth borderShape viewShape top left
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
    18
		extentChanged originChanged cornerChanged relativeOrigin
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
    19
		relativeExtent relativeCorner originRule extentRule cornerRule
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
    20
		insets shown hidden name level margin innerClipRect shadowColor
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
    21
		lightColor viewOrigin bitGravity viewGravity keyboardHandler
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
    22
		model controller windowGroup aspectSymbol changeSymbol menuSymbol'
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
    23
	 classVariableNames:'Grey CentPoint ViewSpacing DefaultStyle StyleSheet
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
    24
		DefaultViewBackgroundColor DefaultBorderColor DefaultLightColor
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
    25
		DefaultShadowColor DefaultBorderWidth DefaultFont
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
    26
		DefaultFocusColor DefaultFocusBorderWidth'
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
    27
	 poolDictionaries:''
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
    28
	 category:'Views-Basic'
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    29
!
48194c26a46c Initial revision
claus
parents:
diff changeset
    30
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    31
View class instanceVariableNames:'ClassResources'!
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    32
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    33
View comment:'
6
7ee0cfde237d *** empty log message ***
claus
parents: 5
diff changeset
    34
COPYRIGHT (c) 1989 by Claus Gittinger
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
    35
	      All Rights Reserved
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
    36
125
d74e6ab7157a *** empty log message ***
claus
parents: 123
diff changeset
    37
$Header: /cvs/stx/stx/libview/View.st,v 1.38 1995-03-26 20:13:34 claus Exp $
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    38
'!
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    39
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    40
!View class methodsFor:'documentation'!
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
    41
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    42
copyright
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    43
"
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    44
 COPYRIGHT (c) 1989 by Claus Gittinger
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
    45
	      All Rights Reserved
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    47
 This software is furnished under a license and may be used
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    48
 only in accordance with the terms of that license and with the
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    49
 inclusion of the above copyright notice.   This software may not
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    50
 be provided or otherwise made available to, or used by, any
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    51
 other person.  No title to or ownership of the software is
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    52
 hereby transferred.
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    53
"
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    54
!
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    55
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    56
version
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    57
"
125
d74e6ab7157a *** empty log message ***
claus
parents: 123
diff changeset
    58
$Header: /cvs/stx/stx/libview/View.st,v 1.38 1995-03-26 20:13:34 claus Exp $
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    59
"
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    60
!
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    61
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
    62
documentation
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    63
"
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
    64
    this class implements functions common to all Views. 
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
    65
    Instances of View are seldom used, most views in the system inherit 
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
    66
    from this class. 
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
    67
    However, sometimes a view is used to create a dummy view for framing 
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
    68
    or layout purposes.
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
    69
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
    70
    Instance variables:
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
    71
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    72
	superView               <View>                  my superview i.e. the view I am in
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    73
	subViews                <Collection>            the collection of subviews
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    74
	window                  <Rectangle>             my window i.e. local coordinate-system
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    75
	viewport                <Rectangle>             my Rectangle in superviews coordinates
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    76
	borderColor             <Color>                 color of border
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    77
	borderWidth             <Number>                borderWidth in pixels (device dep.)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    78
	borderShape             <Form>                  shape of border (if device supports it)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    79
	viewShape               <Form>                  shape of view (if device supports it)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    80
	top                     <Number>                top coordinate in superview
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    81
	left                    <Number>                left coordinate in superview
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    82
	extendChanged           <Boolean>               true if extend changed during setup
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    83
	originChanged           <Boolean>               true if origin changed during setup
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    84
	relativeOrigin          <Number>                relative origin in percent within superview
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    85
	relativeExtent          <Number>                relative extent in percent within superview
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    86
	originRule              <Block>                 rule to compute origin if superview changes size
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    87
	extentRule              <Block>                 rule to compute extent if superview changes size
98
cd6af625d477 *** empty log message ***
claus
parents: 94
diff changeset
    88
	shown                   <Boolean>               true if visible (false if iconified, unmapped or covered)
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    89
	hidden                  <Boolean>               dont show automatically when superview is realized
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    90
	name                    <String>                my name (future use for resources)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    91
	level                   <Number>                3D level relative to superview
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    92
	margin                  <Number>                convenient margin
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    93
	innerClipRect           <Rectangle>             convenient inner clip (minus margin)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    94
	shadowColor             <Color>                 color used to draw 3D shadowed edges
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    95
	lightColor              <Color>                 color used to draw 3D lighted edges
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    96
	viewOrigin              <Point>                 origin within model
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    97
	contentsChanngeAction   <Block>                 action to perform when model contents changes
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    98
	originChangeAction      <Block>                 action to perform when model origin changes
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    99
	bitGravity              <nil | Symbol>          gravity of contents (if device supports it)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   100
	viewGravity             <nil | Symbol>          gravity of view (if device supports it)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   101
	keyboardHandler         <nil | any>             gets keyboard input if non-nil
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   102
	model                   <nil | any>             the model (if any)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   103
	controller              <nil | Controller>      the controller (if any)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   104
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
   105
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
   106
    Class variables:
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
   107
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   108
	Grey                    <Color>                 the color grey - its used so often
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   109
	ViewSpacing             <Number>                prefered spacing between views; 1mm
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   110
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   111
	CentPoint               <Point>                 100 @ 100 - its used so often
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   112
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   113
	StyleSheet              <ResourcePack>          contains all view-style specifics
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   114
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   115
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   116
    styleSheet parameters:
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   117
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   118
	popupShadow             <Boolean>               if true, popupViews show a shadow below
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   119
	popupLevel              <nil | Integer>         3D level
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   120
	borderWidth             <nil | Integer>         borderWidth (ignored in 3D styles)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   121
	borderColor             <nil | Color>           borderColor (ignored in 3D styles)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   122
	viewBackground          <nil | Color>           views background
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   123
	shadowColor             <nil | Color>           color for shadow edges (ignored in 2D styles)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   124
	lightColor              <nil | Color>           color for light edges (ignored in 2D styles)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   125
	font                    <nil | Font>            font to use
108
350822e42e34 *** empty log message ***
claus
parents: 107
diff changeset
   126
350822e42e34 *** empty log message ***
claus
parents: 107
diff changeset
   127
350822e42e34 *** empty log message ***
claus
parents: 107
diff changeset
   128
    TODO:
350822e42e34 *** empty log message ***
claus
parents: 107
diff changeset
   129
	get rid of relativeOrigin, relativeCorner, originRule, extentRule,
350822e42e34 *** empty log message ***
claus
parents: 107
diff changeset
   130
	and insets; replace by a single object which defines the size
350822e42e34 *** empty log message ***
claus
parents: 107
diff changeset
   131
	(mhmh - ST-80 seems to call this LayoutFrame ?)
123
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   132
	-> be prepared for a change here in the near future and ONLY use
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   133
	   access methods to those instance variables
108
350822e42e34 *** empty log message ***
claus
parents: 107
diff changeset
   134
350822e42e34 *** empty log message ***
claus
parents: 107
diff changeset
   135
	add components (could also call them gadgets or lightweight views)
350822e42e34 *** empty log message ***
claus
parents: 107
diff changeset
   136
	- views are expensive in terms of X resources. This would make all
350822e42e34 *** empty log message ***
claus
parents: 107
diff changeset
   137
	framing/edge and panel helper views become cheap ST objects, instead
350822e42e34 *** empty log message ***
claus
parents: 107
diff changeset
   138
	of views.
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   139
"
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   140
! !
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   141
48194c26a46c Initial revision
claus
parents:
diff changeset
   142
!View class methodsFor:'initialization'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   143
48194c26a46c Initial revision
claus
parents:
diff changeset
   144
initialize
125
d74e6ab7157a *** empty log message ***
claus
parents: 123
diff changeset
   145
    DefaultStyle isNil ifTrue:[
d74e6ab7157a *** empty log message ***
claus
parents: 123
diff changeset
   146
	super initialize.
d74e6ab7157a *** empty log message ***
claus
parents: 123
diff changeset
   147
d74e6ab7157a *** empty log message ***
claus
parents: 123
diff changeset
   148
	Font initialize.
d74e6ab7157a *** empty log message ***
claus
parents: 123
diff changeset
   149
	Form initialize.
d74e6ab7157a *** empty log message ***
claus
parents: 123
diff changeset
   150
	Color initialize.
d74e6ab7157a *** empty log message ***
claus
parents: 123
diff changeset
   151
d74e6ab7157a *** empty log message ***
claus
parents: 123
diff changeset
   152
	self defaultStyle:#normal.
d74e6ab7157a *** empty log message ***
claus
parents: 123
diff changeset
   153
123
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   154
"/    self updateStyleCache.
125
d74e6ab7157a *** empty log message ***
claus
parents: 123
diff changeset
   155
	self == View ifTrue:[
d74e6ab7157a *** empty log message ***
claus
parents: 123
diff changeset
   156
	    Smalltalk addDependent:self   "/ to get language changes
d74e6ab7157a *** empty log message ***
claus
parents: 123
diff changeset
   157
	]
d74e6ab7157a *** empty log message ***
claus
parents: 123
diff changeset
   158
    ]
123
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   159
! !
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   160
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   161
!View class methodsFor:'change & update'!
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   162
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   163
update:something
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   164
    something == #Language ifTrue:[
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   165
	"flush resources on language changes"
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   166
	self flushAllClassResources
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   167
    ]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   168
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   169
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   170
!View class methodsFor:'instance creation'!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   171
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   172
in:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   173
    "return a new view as a subview of aView.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   174
     If aView is nil, it is left unspecified, in which superview
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   175
     the new view will be placed. The view can later be assigned
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   176
     by adding it to the superview via #addSubView:.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   177
     If realized and no superview has ever been set, it will come
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   178
     up as a topview."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   179
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   180
    |newView|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   181
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   182
    newView := self basicNew.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   183
    aView notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   184
	newView device:(aView device).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   185
	newView superView:aView.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   186
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   187
	newView device:Display
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   188
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   189
    newView initialize.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   190
    aView notNil ifTrue:[aView addSubView:newView].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   191
    ^ newView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   192
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   193
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   194
label:label in:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   195
    "create a new view as subview of aView with given label"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   196
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   197
    ^ self origin:nil extent:nil borderWidth:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   198
		      font:nil label:label in:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   199
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   200
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   201
extent:extent in:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   202
    "create a new view as a subview of aView with given extent"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   203
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   204
    ^ self origin:nil extent:extent borderWidth:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   205
		      font:nil label:nil in:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   206
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   207
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   208
origin:origin in:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   209
    "create a new view as a subview of aView with given origin"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   210
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   211
    ^ self origin:origin extent:nil borderWidth:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   212
			 font:nil label:nil in:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   213
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   214
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   215
extent:extent
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   216
    "create a new view with given extent"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   217
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   218
    ^ self origin:nil extent:extent borderWidth:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   219
		      font:nil label:nil in:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   220
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   221
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   222
origin:origin extent:extent in:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   223
    "create a new view as a subview of aView with given origin and extent"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   224
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   225
    ^ self origin:origin extent:extent borderWidth:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   226
			 font:nil label:nil in:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   227
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   228
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   229
origin:origin extent:extent
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   230
    "create a new view with given origin and extent"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   231
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   232
    ^ self origin:origin extent:extent borderWidth:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   233
			 font:nil label:nil in:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   234
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   235
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   236
origin:origin extent:extent borderWidth:bw in:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   237
    "create a new view as a subview of aView with given origin, extent
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   238
     and borderWidth"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   239
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   240
    ^ self origin:origin extent:extent borderWidth:bw
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   241
			 font:nil label:nil in:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   242
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   243
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   244
origin:anOrigin extent:anExtent borderWidth:bw font:aFont label:aLabel in:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   245
    |newView|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   246
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   247
    aView notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   248
	newView := self basicNew.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   249
	newView device:(aView device).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   250
	aView addSubView:newView.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   251
	newView initialize
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   252
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   253
	newView := self on:Display
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   254
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   255
    bw notNil ifTrue:[newView borderWidth:bw].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   256
    anExtent notNil ifTrue:[newView extent:anExtent].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   257
    anOrigin notNil ifTrue:[newView origin:anOrigin].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   258
    aFont notNil ifTrue:[newView font:aFont].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   259
    aLabel notNil ifTrue:[newView label:aLabel].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   260
    ^ newView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   261
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   262
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   263
origin:anOrigin corner:aCorner borderWidth:bw font:aFont label:aLabel in:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   264
    |newView|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   265
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   266
    aView notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   267
	newView := self basicNew.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   268
	newView device:(aView device).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   269
	aView addSubView:newView.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   270
	newView initialize
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   271
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   272
	newView := self on:Display
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   273
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   274
    bw notNil ifTrue:[newView borderWidth:bw].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   275
    anOrigin notNil ifTrue:[newView origin:anOrigin].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   276
    aCorner notNil ifTrue:[newView corner:aCorner].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   277
    aFont notNil ifTrue:[newView font:aFont].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   278
    aLabel notNil ifTrue:[newView label:aLabel].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   279
    ^ newView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   280
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   281
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   282
origin:origin corner:corner in:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   283
    "create a new view as a subview of aView with given origin and extent"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   284
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   285
    ^ self origin:origin corner:corner borderWidth:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   286
			 font:nil label:nil in:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   287
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   288
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   289
origin:origin extent:extent borderWidth:bw
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   290
    "create a new view with given origin, extent and borderWidth"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   291
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   292
    ^ self origin:origin extent:extent borderWidth:bw
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   293
			 font:nil label:nil in:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   294
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   295
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   296
label:label
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   297
    "create a new view with given label"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   298
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   299
    ^ self origin:nil extent:nil borderWidth:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   300
		      font:nil label:label in:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   301
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   302
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   303
origin:anOrigin extent:anExtent
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   304
		label:aLabel icon:aForm
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   305
		minExtent:minExtent maxExtent:maxExtent
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   306
    |newView|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   307
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   308
    newView := self on:Display.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   309
    anOrigin notNil ifTrue:[newView origin:anOrigin].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   310
    anExtent notNil ifTrue:[newView extent:anExtent].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   311
    aLabel notNil ifTrue:[newView label:aLabel].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   312
    aForm notNil ifTrue:[newView icon:aForm].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   313
    minExtent notNil ifTrue:[newView minExtent:minExtent].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   314
    maxExtent notNil ifTrue:[newView maxExtent:maxExtent].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   315
    ^ newView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   316
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   317
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   318
extent:extent label:label
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   319
    "create a new view with given extent and label"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   320
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   321
    ^ self origin:nil extent:extent borderWidth:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   322
		      font:nil label:label in:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   323
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   324
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   325
origin:origin extent:extent label:label
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   326
    "create a new view with given origin, extent and label"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   327
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   328
    ^ self origin:origin extent:extent borderWidth:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   329
			 font:nil label:label in:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   330
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   331
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   332
origin:origin extent:extent font:aFont label:label
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   333
    ^ self origin:origin extent:extent borderWidth:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   334
			 font:nil label:label in:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   335
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   336
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   337
origin:origin extent:extent font:aFont label:label in:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   338
    ^ self origin:origin extent:extent borderWidth:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   339
			 font:aFont label:label in:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   340
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   341
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   342
origin:origin corner:corner borderWidth:bw in:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   343
    "create a new view as a subview of aView with given origin and extent"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   344
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   345
    ^ self origin:origin corner:corner borderWidth:bw
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   346
			 font:nil label:nil in:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   347
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   348
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   349
origin:origin corner:corner 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   350
    "create a new view with given origin and extent"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   351
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   352
    ^ self origin:origin corner:corner borderWidth:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   353
			 font:nil label:nil in:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   354
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   355
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   356
on:anObject aspect:aspectMsg change:changeMsg menu:menuMsg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   357
    "st-80 style view creation: create a new view, set its model
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   358
     and access selectors for aspect, change and menu"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   359
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   360
    ^ self new on:anObject
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   361
	   aspect:aspectMsg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   362
	   change:changeMsg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   363
	     menu:menuMsg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   364
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   365
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   366
model:aModel
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   367
    "st-80 style view creation: create a new view and set its model"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   368
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   369
    ^ self new model:aModel
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   370
! !
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   371
123
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   372
!View class methodsFor:'resources'!
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   373
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   374
classResources
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   375
    "if not already loaded, get the classes resourcePack
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   376
     and return it"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   377
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   378
    ClassResources isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   379
	ClassResources := ResourcePack for:self.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   380
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   381
    ^ ClassResources
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   382
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   383
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   384
classResources:aResourcePack
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   385
    "allow setting of the classResources"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   386
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   387
    ClassResources := aResourcePack
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   388
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   389
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   390
flushAllClassResources
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   391
    "flush all classes resource translations.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   392
     Needed after a resource file has changed."
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   393
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   394
    ResourcePack flushCachedResourcePacks.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   395
    self flushClassResources.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   396
    self allSubclassesDo:[:aClass |
123
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   397
	aClass flushClassResources.
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   398
    ]
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   399
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   400
    "
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   401
     View flushAllClassResources
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   402
    "
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   403
    "to change the language:
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   404
	Language := #english.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   405
	Smalltalk changed:#Language.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   406
	View flushAllClassResources
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   407
     or:
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   408
	Language := #german.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   409
	Smalltalk changed:#Language.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   410
	View flushAllClassResources
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   411
    "     
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   412
!
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   413
123
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   414
flushClassResources
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   415
    "flush classes resource string translations.
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   416
     Needed whenever a resource file or language has changed"
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   417
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   418
    ClassResources := nil.
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   419
!
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   420
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   421
updateClassResources
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   422
    "flush classes resource string translations and reload them.
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   423
     Needed whenever a resource file or language has changed"
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   424
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   425
    ClassResources := nil.
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   426
    self classResources
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   427
! !
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   428
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   429
!View class methodsFor:'defaults'!
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   430
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   431
viewSpacing
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   432
    "return a convenient number of pixels used to separate views (usually 1mm).
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   433
     Having this value here at a common place makes certain that all views
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   434
     get a common look"
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   435
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   436
    ^ ViewSpacing
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   437
!
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   438
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   439
defaultExtent
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   440
    "define the default extent"
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   441
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   442
    CentPoint isNil ifTrue:[CentPoint := 100 @ 100].
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   443
    ^ CentPoint
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   444
!
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   445
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   446
defaultStyle
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   447
    "return the default view style"
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   448
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   449
    ^ DefaultStyle
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   450
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   451
    "
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   452
     View defaultStyle
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   453
    "
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   454
!
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   455
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   456
defaultStyle:aStyle
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   457
    "set the view style for new views"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   458
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   459
    aStyle ~~ DefaultStyle ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   460
	DefaultStyle := aStyle.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   461
	self updateAllStyleCaches.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   462
    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   463
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   464
    "
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   465
     View defaultStyle:#next. SystemBrowser start
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   466
     View defaultStyle:#motif. SystemBrowser start
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   467
     View defaultStyle:#iris. SystemBrowser start
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   468
     View defaultStyle:#st80. SystemBrowser start
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   469
     View defaultStyle:#normal. SystemBrowser start
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   470
    "
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   471
!
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   472
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   473
updateAllStyleCaches
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   474
    "reload all style caches in all view classes.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   475
     Needed after a style change or when a style file has been changed"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   476
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   477
    StyleSheet := ViewStyle fromFile:(DefaultStyle , '.style').
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   478
    StyleSheet fileReadFailed ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   479
	('***** WARNING: no styleSheet for ' , DefaultStyle , '-style.') errorPrintNL.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   480
	DefaultStyle := #normal.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   481
	StyleSheet := ViewStyle fromFile:(DefaultStyle , '.style').
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   482
	StyleSheet fileReadFailed  ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   483
	    '***** FATAL: not even a styleSheet for normal-style.' errorPrintNL.
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   484
	    Smalltalk exit
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   485
	]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   486
    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   487
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   488
    "
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   489
     tell all view classes to flush any
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   490
     cached style-data
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   491
    "
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   492
    self changed:#style.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   493
    self updateStyleCache.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   494
    self allSubclassesDo:[:aClass |
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   495
	(aClass class implements:#updateStyleCache) ifTrue:[aClass updateStyleCache].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   496
    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   497
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   498
    "
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   499
     View updateAllStyleCaches
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   500
    "
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   501
!
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   502
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   503
updateStyleCache
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   504
    "this method gets some heavily used style stuff and keeps
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   505
     it in class-variables for faster access.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   506
     Subclasses should redefine this to load any cached style-values
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   507
     into faster class variables as well. These should NOT do a 
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   508
     super updateStyleCache, since this method is called for all view-classes
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   509
     anyway."
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   510
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   511
    |bgGrey|
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   512
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   513
    "
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   514
     when coming here the first time, we read the styleSheet
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   515
     and keep the values in fast class variables
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   516
    "
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   517
    StyleSheet isNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   518
	DefaultStyle := #normal.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   519
	StyleSheet := ViewStyle fromFile:'normal.style'.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   520
    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   521
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   522
    Grey := StyleSheet viewGrey.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   523
    Grey isNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   524
	Grey := Color grey
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   525
    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   526
    Grey := Grey on:Display.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   527
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   528
    Display hasGreyscales ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   529
	bgGrey := Grey
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   530
    ] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   531
	bgGrey := White on:Display 
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   532
    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   533
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   534
    ViewSpacing := StyleSheet at:'viewSpacing'.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   535
    ViewSpacing isNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   536
	ViewSpacing := Display verticalPixelPerMillimeter rounded.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   537
    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   538
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   539
    DefaultBorderWidth := StyleSheet at:'borderWidth' default:0.
78
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
   540
    DefaultBorderColor := StyleSheet colorAt:'borderColor' default:Black.
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
   541
    DefaultViewBackgroundColor := StyleSheet colorAt:'viewBackground' default:bgGrey.
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
   542
    DefaultShadowColor := StyleSheet colorAt:'shadowColor'.
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
   543
    DefaultLightColor := StyleSheet colorAt:'lightColor'.
89
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
   544
    DefaultFocusColor := StyleSheet colorAt:'focusColor' default:Color red.
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
   545
    DefaultFocusBorderWidth := StyleSheet at:'focusBorderWidth' default:2.
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
   546
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   547
    DefaultFont := StyleSheet at:'font'.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   548
    DefaultFont isNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   549
	DefaultFont := Font family:'courier' face:'medium' style:'roman' size:12.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   550
    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   551
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   552
    DefaultFont := DefaultFont on:Display.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   553
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   554
    DefaultViewBackgroundColor isNil ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   555
	'bad viewBackground in style - using white' errorPrintNL.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   556
	DefaultViewBackgroundColor := White
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   557
    ].
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   558
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   559
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   560
styleSheet:aViewStyle
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   561
    "set the view style from a style-sheet"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   562
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   563
    StyleSheet := aViewStyle.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   564
    DefaultStyle := (StyleSheet at:'name' ifAbsent:'unknown') asSymbol.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   565
    self updateAllStyleCaches.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   566
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   567
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   568
!View methodsFor:'accessing-dimensions'!
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   569
48194c26a46c Initial revision
claus
parents:
diff changeset
   570
extent:extent
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   571
    "set the views extent; extent may be:
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   572
     a point where integer fields mean pixel-values
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   573
     and float values mean relative-to-superview;
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   574
     or a block returning a point"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   575
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   576
    |w h pixelExtent e|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   577
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   578
    extent isBlock ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   579
	extentRule := extent.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   580
	drawableId notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   581
	    pixelExtent := extent value
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   582
	] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   583
	    extentChanged := true
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   584
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   585
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   586
	w := extent x.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   587
	h := extent y.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   588
	w isNil ifTrue:[w := width].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   589
	h isNil ifTrue:[h := height].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   590
	e := w@h.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   591
	((w isInteger not) or:[h isInteger not]) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   592
	    relativeExtent := e.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   593
	    pixelExtent := self extentFromRelativeExtent.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   594
	    pixelExtent isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   595
		extentChanged := true
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   596
	    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   597
	] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   598
	    pixelExtent := e
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   599
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   600
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   601
    pixelExtent notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   602
	self pixelExtent:pixelExtent
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   603
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   604
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   605
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   606
top
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   607
    "return the y position of the top border"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   608
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   609
    ^ top
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   610
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   611
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   612
corner:corner 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   613
    "set the views  corner;  corner may be:
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   614
     a point where integer fields mean pixel-values
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   615
     and float values mean relative-to-superview;
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   616
     or a block returning a point"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   617
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   618
    |x y pixelCorner c|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   619
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   620
    corner isBlock ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   621
	cornerRule := corner.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   622
	drawableId notNil ifTrue:[    
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   623
	    pixelCorner := corner value
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   624
	] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   625
	    extentChanged := true
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   626
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   627
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   628
	x := corner x.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   629
	y := corner y.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   630
	x isNil ifTrue:[x := self corner x].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   631
	y isNil ifTrue:[y := self corner y].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   632
	c := x @ y.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   633
	((x isInteger not) or:[y isInteger not]) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   634
	    relativeCorner := c.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   635
	    pixelCorner := self cornerFromRelativeCorner.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   636
	    pixelCorner isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   637
		extentChanged := true
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   638
	    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   639
	] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   640
	    pixelCorner := c
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   641
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   642
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   643
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   644
    pixelCorner notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   645
	self pixelCorner:pixelCorner
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   646
    ]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   647
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   648
48194c26a46c Initial revision
claus
parents:
diff changeset
   649
origin:origin extent:extent
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   650
    "set both origin and extent"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   651
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   652
    |newLeft newTop newWidth newHeight|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   653
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   654
    "do it as one operation if possible"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   655
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   656
    origin isBlock ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   657
	extent isBlock ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   658
	    newLeft := origin x.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   659
	    (newLeft isMemberOf:Float) ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   660
		newTop := origin y.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   661
		(newTop isMemberOf:Float) ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   662
		    newWidth := extent x.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   663
		    (newWidth isMemberOf:Float) ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   664
			newHeight := extent y.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   665
			(newHeight isMemberOf:Float) ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   666
			    self pixelOrigin:origin extent:extent
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   667
			]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   668
		    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   669
		]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   670
	    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   671
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   672
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   673
    self extent:extent.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   674
    self origin:origin
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   675
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   676
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   677
origin
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   678
    "return the origin (in pixels)"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   679
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   680
    ^ left@top
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   681
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   682
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   683
innerWidth
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   684
    "return the width of the view minus any 3D-shadow-borders"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   685
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   686
    (level == 0) ifTrue:[^ width].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   687
    ^ width - (2 * margin)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   688
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   689
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   690
origin:origin
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   691
    "set the views origin; origin may be:
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   692
     a point where integer fields mean pixel-values
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   693
     and float values mean relative-to-superview;
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   694
     or a block returning a point"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   695
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   696
    |newLeft newTop pixelOrigin o|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   697
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   698
    origin isBlock ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   699
	originRule := origin.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   700
	drawableId notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   701
	    pixelOrigin := origin value
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   702
	] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   703
	    originChanged := true
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   704
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   705
    ] ifFalse:[
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   706
	o := origin.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   707
	newLeft := origin x.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   708
	newTop := origin y.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   709
	newLeft isNil ifTrue:[newLeft := left].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   710
	newTop isNil ifTrue:[newTop := top].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   711
	o := newLeft @ newTop.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   712
	((newLeft isInteger not) or:[newTop isInteger not]) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   713
	    relativeOrigin := o.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   714
	    pixelOrigin := self originFromRelativeOrigin.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   715
	    pixelOrigin isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   716
		originChanged := true
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   717
	    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   718
	] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   719
	    pixelOrigin := o
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   720
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   721
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   722
    pixelOrigin notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   723
	self pixelOrigin:pixelOrigin
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   724
    ].
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   725
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   726
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   727
height:aNumber
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   728
    "set the views height in pixels"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   729
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   730
    self extent:(width @ aNumber)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   731
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   732
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   733
makeFullyVisible
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   734
    "make sure, that the view is fully visible by shifting it
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   735
     into the visible screen area if nescessary"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   736
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   737
    ((top + height) > (device height)) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   738
	self top:(device height - height)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   739
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   740
    ((left + width) > (device width)) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   741
	self left:(device width - width)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   742
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   743
    (top < 0) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   744
	self top:0
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   745
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   746
    (left < 0) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   747
	self left:0
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   748
    ].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   749
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   750
48194c26a46c Initial revision
claus
parents:
diff changeset
   751
origin:origin corner:corner 
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   752
    "set both origin and extent"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   753
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   754
    |newLeft newTop newRight newBot|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   755
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   756
    "do it as one operation if possible"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   757
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   758
    origin isBlock ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   759
	corner isBlock ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   760
	    newLeft := origin x.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   761
	    (newLeft isMemberOf:Float) ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   762
		newTop := origin y.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   763
		(newTop isMemberOf:Float) ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   764
		    newRight := corner x.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   765
		    (newRight isMemberOf:Float) ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   766
			newBot := corner y.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   767
			(newBot isMemberOf:Float) ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   768
			    self pixelOrigin:origin corner:corner 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   769
			]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   770
		    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   771
		]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   772
	    ]
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   773
	]
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   774
    ].
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   775
    self origin:origin.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   776
    self corner:corner 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   777
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   778
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   779
relativeCorner
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   780
    "return the relative corner or nil"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   781
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   782
    ^ relativeCorner
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   783
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   784
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   785
width:aNumber
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   786
    "set the views width in pixels"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   787
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   788
    self extent:(aNumber @ height)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   789
!
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   790
48194c26a46c Initial revision
claus
parents:
diff changeset
   791
left:aNumber
48194c26a46c Initial revision
claus
parents:
diff changeset
   792
    "set the x position"
48194c26a46c Initial revision
claus
parents:
diff changeset
   793
48194c26a46c Initial revision
claus
parents:
diff changeset
   794
    self origin:(aNumber @ top)
48194c26a46c Initial revision
claus
parents:
diff changeset
   795
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   796
48194c26a46c Initial revision
claus
parents:
diff changeset
   797
top:aNumber
48194c26a46c Initial revision
claus
parents:
diff changeset
   798
    "set the y position"
48194c26a46c Initial revision
claus
parents:
diff changeset
   799
48194c26a46c Initial revision
claus
parents:
diff changeset
   800
    self origin:(left @ aNumber)
48194c26a46c Initial revision
claus
parents:
diff changeset
   801
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   802
123
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   803
rightInset
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   804
    "return the inset of the right edge; positive is to the left,
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   805
     negative to the right"
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   806
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   807
    insets isNil ifTrue:[^ 0].
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   808
    ^ insets at:3 
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   809
!
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   810
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   811
rightInset:aNumber
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   812
    "set the inset of the right edge; positive is to the left,
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   813
     negative to the right"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   814
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   815
    insets isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   816
	insets := Array new:4 withAll:0.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   817
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   818
    insets at:3 put:aNumber.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   819
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   820
    "force recomputation"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   821
    drawableId isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   822
	originChanged := true
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   823
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   824
	self superViewChangedSize
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   825
    ]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   826
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   827
123
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   828
leftInset
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   829
    "return the inset of the left edge; positive is to the right,
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   830
     negative to the left"
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   831
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   832
    insets isNil ifTrue:[^ 0].
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   833
    ^ insets at:1 
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   834
!
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   835
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   836
leftInset:aNumber
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   837
    "set the inset of the left edge; positive is to the right,
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   838
     negative to the left"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   839
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   840
    insets isNil ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   841
	insets := Array new:4 withAll:0.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   842
    ].
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   843
    insets at:1 put:aNumber.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   844
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   845
    "force recomputation"
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   846
    drawableId isNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   847
	originChanged := true
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   848
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   849
	self superViewChangedSize
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   850
    ]
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   851
!
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   852
123
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   853
topInset
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   854
    "return the inset of the top edge; positive is to the bottom,
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   855
     negative to the top"
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   856
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   857
    insets isNil ifTrue:[^ 0].
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   858
    ^ insets at:2 
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   859
!
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   860
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   861
topInset:aNumber
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   862
    "set the inset of the top edge; positive is to the bottom,
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   863
     negative to the top"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   864
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   865
    insets isNil ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   866
	insets := Array new:4 withAll:0.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   867
    ].
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   868
    insets at:2 put:aNumber.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   869
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   870
    "force recomputation"
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   871
    drawableId isNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   872
	originChanged := true
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   873
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   874
	self superViewChangedSize
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   875
    ]
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   876
!
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   877
123
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   878
bottomInset
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   879
    "return the inset of the bottom edge; positive is to the top,
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   880
     negative to the bottom"
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   881
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   882
    insets isNil ifTrue:[^ 0].
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   883
    ^ insets at:4
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   884
!
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   885
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   886
bottomInset:aNumber
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   887
    "set the inset of the bottom edge; positive is to the top,
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   888
     negative to the bottom"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   889
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   890
    insets isNil ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   891
	insets := Array new:4 withAll:0.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   892
    ].
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   893
    insets at:4 put:aNumber.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   894
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   895
    "force recomputation"
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   896
    drawableId isNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   897
	originChanged := true
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   898
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   899
	self superViewChangedSize
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   900
    ]
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   901
!
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   902
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   903
relativeOrigin
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   904
    "return the relative origin or nil"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   905
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   906
    ^ relativeOrigin
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   907
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   908
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   909
right:aNumber
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   910
    "set the corners x position"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   911
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   912
    self corner:(aNumber @ self corner y)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   913
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   914
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   915
bottom:aNumber
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   916
    "set the corners y position"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   917
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   918
    self corner:(self corner x @ aNumber)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   919
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   920
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   921
corner
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   922
    "return the lower right corner-point"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   923
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   924
    ^ (left + width - 1) @ (top + height - 1)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   925
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   926
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   927
innerHeight
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   928
    "return the height of the view minus any 3D-shadow-borders"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   929
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   930
    (margin == 0) ifTrue:[^ height].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   931
    ^ height - (2 * margin)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   932
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   933
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   934
relativeCorner:aPoint
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   935
    "set the relative corner"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   936
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   937
    relativeCorner := aPoint
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   938
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
   939
87
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
   940
inset:aNumber
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
   941
    "set all insets; positive makes the view smaller,
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
   942
     negative makes it larger."
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
   943
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
   944
    insets isNil ifTrue:[
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
   945
	insets := Array new:4.
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
   946
    ].
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
   947
    insets atAllPut:aNumber.
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
   948
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
   949
    "force recomputation"
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
   950
    drawableId isNil ifTrue:[
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
   951
	originChanged := true
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
   952
    ] ifFalse:[
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
   953
	self superViewChangedSize
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
   954
    ]
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
   955
!
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
   956
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   957
left:newLeft top:newTop width:newWidth height:newHeight
48194c26a46c Initial revision
claus
parents:
diff changeset
   958
    "another way of specifying origin and extent"
48194c26a46c Initial revision
claus
parents:
diff changeset
   959
48194c26a46c Initial revision
claus
parents:
diff changeset
   960
    self origin:(newLeft @ newTop) extent:(newWidth @ newHeight)
48194c26a46c Initial revision
claus
parents:
diff changeset
   961
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   962
48194c26a46c Initial revision
claus
parents:
diff changeset
   963
relativeExtent
48194c26a46c Initial revision
claus
parents:
diff changeset
   964
    "return the relative extent or nil"
48194c26a46c Initial revision
claus
parents:
diff changeset
   965
48194c26a46c Initial revision
claus
parents:
diff changeset
   966
    ^ relativeExtent
48194c26a46c Initial revision
claus
parents:
diff changeset
   967
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   968
48194c26a46c Initial revision
claus
parents:
diff changeset
   969
relativeOrigin:aPoint
48194c26a46c Initial revision
claus
parents:
diff changeset
   970
    "set the relative origin"
48194c26a46c Initial revision
claus
parents:
diff changeset
   971
48194c26a46c Initial revision
claus
parents:
diff changeset
   972
    relativeOrigin := aPoint
48194c26a46c Initial revision
claus
parents:
diff changeset
   973
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   974
48194c26a46c Initial revision
claus
parents:
diff changeset
   975
originRelativeTo:aView
123
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   976
    "return the origin (in pixels) relative to a superView,
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   977
     or relative to the Display (if aView is nil).
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   978
     If the receiver is not a subview of aView, return nil."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   979
48194c26a46c Initial revision
claus
parents:
diff changeset
   980
    |currentView
48194c26a46c Initial revision
claus
parents:
diff changeset
   981
     org  "{ Class: Point }"
48194c26a46c Initial revision
claus
parents:
diff changeset
   982
     sumX "{ Class: SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
   983
     sumY "{ Class: SmallInteger }" |
48194c26a46c Initial revision
claus
parents:
diff changeset
   984
48194c26a46c Initial revision
claus
parents:
diff changeset
   985
    currentView := self.
48194c26a46c Initial revision
claus
parents:
diff changeset
   986
    sumX := 0.
48194c26a46c Initial revision
claus
parents:
diff changeset
   987
    sumY := 0.
48194c26a46c Initial revision
claus
parents:
diff changeset
   988
    [currentView notNil] whileTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   989
	(currentView == aView) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   990
	    ^ (sumX @ sumY)
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   991
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   992
	org := currentView origin.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   993
	sumX := sumX + org x.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   994
	sumY := sumY + org y.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   995
	currentView := currentView superView
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   996
    ].
123
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   997
    (aView isNil or:[aView == RootView]) ifTrue:[
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   998
	"return relative to screen ..."
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
   999
	^ (sumX @ sumY)
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
  1000
    ].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1001
    ^ nil
48194c26a46c Initial revision
claus
parents:
diff changeset
  1002
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1003
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1004
relativeExtent:aPoint
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1005
    "set the relative extent"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1006
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1007
    relativeExtent := aPoint
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1008
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1009
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1010
center:newCenter
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1011
    "move the receiver so that newCenter, aPoint becomes the center point"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1012
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1013
    self origin:(newCenter - ((width // 2) @ (height // 2)))
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1014
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1015
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1016
center
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1017
    "return the point at the center of the receiver"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1018
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1019
    ^ (left + (width // 2)) @ (top + (height // 2))
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1020
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1021
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1022
left
48194c26a46c Initial revision
claus
parents:
diff changeset
  1023
    "return the x position of the left border"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1024
48194c26a46c Initial revision
claus
parents:
diff changeset
  1025
    ^ left
48194c26a46c Initial revision
claus
parents:
diff changeset
  1026
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1027
48194c26a46c Initial revision
claus
parents:
diff changeset
  1028
right
48194c26a46c Initial revision
claus
parents:
diff changeset
  1029
    "return the x position of the right border"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1030
48194c26a46c Initial revision
claus
parents:
diff changeset
  1031
    ^ left + width - 1
48194c26a46c Initial revision
claus
parents:
diff changeset
  1032
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1033
48194c26a46c Initial revision
claus
parents:
diff changeset
  1034
bottom
48194c26a46c Initial revision
claus
parents:
diff changeset
  1035
    "return the y position of the bottom border"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1036
48194c26a46c Initial revision
claus
parents:
diff changeset
  1037
    ^ top + height - 1
48194c26a46c Initial revision
claus
parents:
diff changeset
  1038
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1039
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1040
computeCorner
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1041
    "compute my corner; if I have relative
121
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1042
     origins or blocks to evaluate, do it now ..
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1043
     Blocks may return relative values or nil; nil means: take current value."
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1044
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1045
    |org newCorner newExt x y|
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1046
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1047
    (cornerRule notNil) ifTrue:[
121
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1048
	newCorner := cornerRule value.
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1049
	"
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1050
	 allow return of relative values ...
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1051
	"
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1052
	x := newCorner x.
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1053
	y := newCorner y.
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1054
	x isNil ifTrue:[x := self corner x].
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1055
	y isNil ifTrue:[y := self corner y].
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1056
	((x isInteger not) or:[y isInteger not]) ifTrue:[
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1057
	    newCorner := self cornerFromRelativeCorner:x@y 
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1058
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1059
    ] ifFalse:[
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1060
	(relativeCorner notNil) ifTrue:[
121
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1061
	    newCorner := self cornerFromRelativeCorner:relativeCorner
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1062
	] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1063
	    org := self computeOrigin.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1064
	    (extentRule notNil) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1065
		newExt := extentRule value
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1066
	    ] ifFalse:[
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1067
		(relativeExtent notNil) ifTrue:[
121
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1068
		    newExt := self extentFromRelativeExtent:relativeExtent 
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1069
		]
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1070
	    ].
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1071
	    newCorner := org + newExt
87
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
  1072
	]
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
  1073
    ].
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1074
    ^ newCorner
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1075
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1076
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1077
computeExtent
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1078
    "compute my extent; if I have relative
121
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1079
     extent or blocks to evaluate, do it now ..
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1080
     There is one catch here, if the dimension was defined
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1081
     by origin/corner, compute them here and take that value.
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1082
     I.e. origin/corner definition has precedence over extent definition."
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1083
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1084
    |newOrg newExt newCorner x y|
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1085
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1086
    (cornerRule notNil) ifTrue:[
121
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1087
	newCorner := cornerRule value.
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1088
	"
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1089
	 allow return of relative values ...
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1090
	"
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1091
	x := newCorner x.
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1092
	y := newCorner y.
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1093
	x isNil ifTrue:[x := self corner x].
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1094
	y isNil ifTrue:[y := self corner y].
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1095
	((x isInteger not) or:[y isInteger not]) ifTrue:[
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1096
	    newCorner := self cornerFromRelativeCorner:x@y
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1097
	]
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1098
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1099
	(relativeCorner notNil) ifTrue:[
121
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1100
	    newCorner := self cornerFromRelativeCorner:relativeCorner
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1101
	] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1102
	    (extentRule notNil) ifTrue:[
121
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1103
		newExt := extentRule value.
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1104
		"
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1105
		 allow return of relative values ...
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1106
		"
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1107
		x := newExt x.
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1108
		y := newExt y.
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1109
		x isNil ifTrue:[x := width].
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1110
		y isNil ifTrue:[y := height].
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1111
		((x isInteger not) or:[y isInteger not]) ifTrue:[
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1112
		    newExt := self extentFromRelativeExtent:x@y
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1113
		]
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1114
	    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1115
		(relativeExtent notNil) ifTrue:[
121
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1116
		    newExt := self extentFromRelativeExtent:relativeExtent
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1117
		] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1118
		    newExt := (width @ height).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1119
		].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1120
	    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1121
	].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1122
    ].
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1123
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1124
    newCorner notNil ifTrue:[
121
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1125
	newOrg := self computeOrigin.
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1126
	^ newCorner - newOrg.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1127
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1128
    ^ newExt.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1129
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1130
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1131
computeOrigin
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1132
    "compute my origin; if I have relative
121
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1133
     origins or blocks to evaluate, do it now ..
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1134
     Blocks may return relative values or nil; nil means: take current value."
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1135
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1136
    |newOrg x y|
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1137
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1138
    (originRule notNil) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1139
	newOrg := originRule value.
121
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1140
	"
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1141
	 allow return of relative values ...
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1142
	"
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1143
	x := newOrg x.
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1144
	y := newOrg y.
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1145
	x isNil ifTrue:[x := self origin x].
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1146
	y isNil ifTrue:[y := self origin y].
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1147
	((x isInteger not) or:[y isInteger not]) ifTrue:[
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1148
	    newOrg := self originFromRelativeOrigin:x@y.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1149
	]
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1150
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1151
	(relativeOrigin notNil) ifTrue:[
121
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1152
	    newOrg := self originFromRelativeOrigin:relativeOrigin.
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1153
	] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1154
	    ^ (left @ top).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1155
	].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1156
    ].
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1157
    ^ newOrg
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1158
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1159
48194c26a46c Initial revision
claus
parents:
diff changeset
  1160
!View methodsFor:'informing others of changes'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1161
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1162
originChanged:delta
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1163
    "this one is sent, after the origin of my contents has changed -
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1164
     tell dependents (i.e. scrollers) about this"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1165
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1166
    self changed:#originOfContents with:delta.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1167
"/   subViews notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1168
"/        subViews do:[:aSubView |
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1169
"/            aSubView pixelOrigin:((aSubView left @ aSubView top) - delta)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1170
"/        ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1171
"/    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1172
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1173
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1174
contentsChanged
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1175
    "this one is sent, whenever contents changes size -
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1176
     tell dependents about the change (i.e. scrollers)."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1177
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1178
    self changed:#sizeOfContents
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1179
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1180
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1181
originWillChange
48194c26a46c Initial revision
claus
parents:
diff changeset
  1182
    "this one is sent, just before viewOrigin changes -
48194c26a46c Initial revision
claus
parents:
diff changeset
  1183
     gives subclasses a chance to catch scrolls easily
48194c26a46c Initial revision
claus
parents:
diff changeset
  1184
     (for example to hide cursor before scroll)"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1185
48194c26a46c Initial revision
claus
parents:
diff changeset
  1186
    ^ self
48194c26a46c Initial revision
claus
parents:
diff changeset
  1187
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1188
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1189
!View methodsFor:'accessing-mvc'!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1190
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1191
sendChangeMessageWith:arg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1192
    |n|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1193
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1194
    "/
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1195
    "/ MVC way of doing it
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1196
    "/
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1197
    (model notNil and:[changeSymbol notNil]) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1198
	n := changeSymbol numArgs.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1199
	n == 0 ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1200
	    model perform:changeSymbol
107
ef48048a8b34 *** empty log message ***
claus
parents: 98
diff changeset
  1201
	] ifFalse:[
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1202
	    n == 1 ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1203
		model perform:changeSymbol with:arg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1204
	    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1205
		model perform:changeSymbol with:arg with:self 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1206
	    ]
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1207
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1208
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1209
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1210
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1211
windowGroup
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1212
    "return the window group. For old style views, return nil"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1213
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1214
    ^ windowGroup
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1215
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1216
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1217
windowGroup:aGroup
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1218
    "set the window group."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1219
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1220
    windowGroup := aGroup
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1221
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1222
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1223
model
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1224
    "return the model, for non-MVC views,
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1225
     this is nil or the receiver"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1226
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1227
    ^ model
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1228
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1229
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1230
model:aModel
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1231
    "set the model"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1232
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1233
    model notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1234
	model removeDependent:self
89
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  1235
    ].
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1236
    model := aModel.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1237
    model notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1238
	aModel addDependent:self
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1239
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1240
    controller notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1241
	controller model:aModel
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1242
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1243
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1244
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1245
controller
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1246
    "return the controller. For non MVC views, return nil"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1247
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1248
    ^ controller
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1249
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1250
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1251
controller:aController
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1252
    "set the controller"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1253
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1254
    controller := aController.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1255
    controller notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1256
	controller view:self.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1257
	controller model:model
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1258
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1259
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1260
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1261
on:aModel aspect:aspectMsg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1262
    "ST-80 compatibility: set model and aspect
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1263
     messages - needs a view which uses these"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1264
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1265
    aspectSymbol := aspectMsg.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1266
    self model:aModel.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1267
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1268
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1269
on:aModel aspect:aspectMsg menu:menuMsg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1270
    "ST-80 compatibility: set model, aspect and menu
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1271
     messages - needs a view which uses these"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1272
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1273
    aspectSymbol := aspectMsg.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1274
    menuSymbol := menuMsg.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1275
    self model:aModel.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1276
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1277
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1278
on:aModel aspect:aspectMsg change:changeMsg menu:menuMsg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1279
    "ST-80 compatibility: set model, aspect, change and menu
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1280
     messages - needs a view which uses these"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1281
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1282
    aspectSymbol := aspectMsg.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1283
    changeSymbol := changeMsg.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1284
    menuSymbol := menuMsg.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1285
    self model:aModel.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1286
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1287
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1288
menu:menuMsg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1289
    "ST-80 style menus: If a views menuSymbol is nonNil, it
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1290
     will send it to its model when the middleButton is pressed.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1291
     That method should return nil or the menu to be shown.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1292
     This is useful for very dynamic menus, where it does not
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1293
     make sense to define an initial menu."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1294
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1295
    menuSymbol := menuMsg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1296
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1297
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1298
change:changeMsg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1299
    "ST-80 style change notification: If a views changeSymbol is nonNil, 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1300
     it will send it to its model when something changes."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1301
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1302
    changeSymbol := changeMsg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1303
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1304
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1305
aspect:aspectMsg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1306
    "ST-80 style updating: If a views aspectSymbol is nonNil, 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1307
     it will respond to changes of this aspect from the model."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1308
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1309
    aspectSymbol := aspectMsg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1310
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1311
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1312
changeSymbol
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1313
    "Return the symbol sent to the model if nonNil when something changes."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1314
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1315
    ^ changeSymbol
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1316
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1317
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1318
menuSymbol
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1319
    "Return the symbol sent to the model to aquire the menu"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1320
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1321
    ^ menuSymbol
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1322
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1323
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1324
aspectSymbol
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1325
    "Return the aspect used with changes from/to the model"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1326
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1327
    ^ menuSymbol
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1328
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1329
48194c26a46c Initial revision
claus
parents:
diff changeset
  1330
!View methodsFor:'private'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1331
48194c26a46c Initial revision
claus
parents:
diff changeset
  1332
pixelExtent:extent
48194c26a46c Initial revision
claus
parents:
diff changeset
  1333
    "set the views extent in pixels"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1334
15
ba1100f2ca03 fixed resize (smaller) border repaint bug
claus
parents: 12
diff changeset
  1335
    self pixelOrigin:(left @ top) extent:extent
ba1100f2ca03 fixed resize (smaller) border repaint bug
claus
parents: 12
diff changeset
  1336
!
ba1100f2ca03 fixed resize (smaller) border repaint bug
claus
parents: 12
diff changeset
  1337
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1338
pixelOrigin:origin
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1339
    "set the views origin in pixels. For subviews. the origin is relative
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1340
     to the superviews top-left. For topViews, its the screen origin."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1341
48194c26a46c Initial revision
claus
parents:
diff changeset
  1342
    |newLeft newTop|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1343
48194c26a46c Initial revision
claus
parents:
diff changeset
  1344
    newLeft := origin x.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1345
    newTop := origin y.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1346
    ((newTop ~~ top) or:[newLeft ~~ left]) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1347
	top := newTop.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1348
	left := newLeft.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1349
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1350
	"
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1351
	 if the receiver is visible, or is a topView, perform the
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1352
	 operation right away - otherwise, simply remember that the
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1353
	 origin has changed - will tell the display once we get realized
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1354
	"
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1355
	(shown 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1356
	or:[superView isNil and:[drawableId notNil]]) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1357
	    device moveWindow:drawableId x:left y:top
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1358
	] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1359
	    originChanged := true
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1360
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1361
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1362
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1363
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1364
computeInnerClip
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1365
    "compute, but do not set the inside clip-area"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1366
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1367
    |m2 nX nY nW nH|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1368
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1369
    (margin ~~ 0) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1370
	m2 := margin + margin.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1371
	nX := nY := margin.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1372
	nW := width - m2.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1373
	nH := height - m2.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1374
	transformation notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1375
	    nX := transformation applyInverseToX:nX.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1376
	    nY := transformation applyInverseToY:nY.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1377
	    nW := transformation applyInverseScaleX:nW.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1378
	    nH := transformation applyInverseScaleY:nH.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1379
	].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1380
	innerClipRect := Rectangle 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1381
				 left:nX 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1382
				 top:nY 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1383
				 width:nW 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1384
				 height:nH
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1385
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1386
	"no clipping"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1387
	innerClipRect := nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1388
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1389
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1390
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1391
setInnerClip
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1392
    "compute, and set the inside clip-area"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1393
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1394
    self computeInnerClip.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1395
    self clipRect:innerClipRect
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1396
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1397
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1398
originFromRelativeOrigin
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1399
    "compute & return pixel origin from relativeOrigin"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1400
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1401
    ^ self originFromRelativeOrigin:relativeOrigin
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1402
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1403
48194c26a46c Initial revision
claus
parents:
diff changeset
  1404
pixelOrigin:origin extent:extent
48194c26a46c Initial revision
claus
parents:
diff changeset
  1405
    "set the views origin and extent in pixels"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1406
15
ba1100f2ca03 fixed resize (smaller) border repaint bug
claus
parents: 12
diff changeset
  1407
    |newLeft newTop newWidth newHeight how 
ba1100f2ca03 fixed resize (smaller) border repaint bug
claus
parents: 12
diff changeset
  1408
     mustRedrawBottomEdge mustRedrawRightEdge mustRepaintBottom
ba1100f2ca03 fixed resize (smaller) border repaint bug
claus
parents: 12
diff changeset
  1409
     mustRepaintRight sameOrigin oldWidth oldHeight|
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1410
48194c26a46c Initial revision
claus
parents:
diff changeset
  1411
    newLeft := origin x.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1412
    newTop := origin y.
15
ba1100f2ca03 fixed resize (smaller) border repaint bug
claus
parents: 12
diff changeset
  1413
    sameOrigin := ((newTop == top) and:[newLeft == left]).
ba1100f2ca03 fixed resize (smaller) border repaint bug
claus
parents: 12
diff changeset
  1414
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1415
    newWidth := extent x.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1416
    newHeight := extent y.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1417
94
8931597dfa3c *** empty log message ***
claus
parents: 89
diff changeset
  1418
    "
8931597dfa3c *** empty log message ***
claus
parents: 89
diff changeset
  1419
     X complains badly if you try to create/resize a view with
8931597dfa3c *** empty log message ***
claus
parents: 89
diff changeset
  1420
     a dimension <= 0 ... (although I think that 0 maks sense ...)
8931597dfa3c *** empty log message ***
claus
parents: 89
diff changeset
  1421
    "
8931597dfa3c *** empty log message ***
claus
parents: 89
diff changeset
  1422
    newWidth < 1 ifTrue:[
8931597dfa3c *** empty log message ***
claus
parents: 89
diff changeset
  1423
	newWidth := 1.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1424
    ].
94
8931597dfa3c *** empty log message ***
claus
parents: 89
diff changeset
  1425
    newHeight < 1 ifTrue:[
8931597dfa3c *** empty log message ***
claus
parents: 89
diff changeset
  1426
	newHeight := 1
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1427
    ].
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1428
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1429
    ((newWidth == width) and:[newHeight == height]) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1430
	sameOrigin ifTrue:[^ self].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1431
	^ self pixelOrigin:origin
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1432
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1433
    top := newTop.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1434
    left := newLeft.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1435
48194c26a46c Initial revision
claus
parents:
diff changeset
  1436
    mustRedrawBottomEdge := (level ~~ 0) and:[newHeight < height].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1437
    mustRedrawRightEdge := (level ~~ 0) and:[newWidth < width].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1438
48194c26a46c Initial revision
claus
parents:
diff changeset
  1439
    ((newHeight <= height) and:[newWidth <= width]) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1440
	how := #smaller
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1441
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1442
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1443
"/    shown ifTrue:[                  "4-nov-94 actually correct,"
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1444
    drawableId notNil ifTrue:[        "but theres a bug in menus when resized while hidden"
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1445
	mustRepaintRight := false.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1446
	mustRepaintBottom := false.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1447
	(level ~~ 0) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1448
	    "clear the old edges"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1449
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1450
	    newWidth > width ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1451
		self clipRect:nil.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1452
		self paint:viewBackground.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1453
		self fillDeviceRectangleX:(width - margin)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1454
					y:0
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1455
				    width:margin
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1456
				   height:height.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1457
		mustRepaintRight := true.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1458
		oldWidth := width
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1459
	    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1460
	    newHeight > height ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1461
		self clipRect:nil.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1462
		self paint:viewBackground.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1463
		self fillDeviceRectangleX:0
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1464
					y:(height - margin)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1465
				    width:width
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1466
				   height:margin.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1467
		mustRepaintBottom := true.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1468
		oldHeight := height
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1469
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1470
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1471
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1472
	width := newWidth.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1473
	height := newHeight.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1474
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1475
	self setInnerClip.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1476
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1477
	"if view becomes smaller, send sizeChanged first"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1478
	(how == #smaller) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1479
	    self sizeChanged:how
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1480
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1481
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1482
	"have to tell X, when extent of view is changed"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1483
	sameOrigin ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1484
	    device resizeWindow:drawableId width:width height:height.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1485
	] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1486
	    "claus: some xservers seem to do better when resizing
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1487
	     first ...."
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1488
" 
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1489
	    (how == #smaller) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1490
		device resizeWindow:drawableId width:width height:height.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1491
		device moveWindow:drawableId x:left y:top
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1492
	    ] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1493
		device moveResizeWindow:drawableId x:left y:top width:width height:height
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1494
	    ].
15
ba1100f2ca03 fixed resize (smaller) border repaint bug
claus
parents: 12
diff changeset
  1495
" 
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1496
	    device moveResizeWindow:drawableId x:left y:top
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1497
					   width:width height:height.
15
ba1100f2ca03 fixed resize (smaller) border repaint bug
claus
parents: 12
diff changeset
  1498
" "
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1499
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1500
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1501
	"if view becomes bigger, send sizeChanged after"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1502
	(how ~~ #smaller) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1503
	    self sizeChanged:how
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1504
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1505
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1506
	(mustRedrawBottomEdge or:[mustRedrawRightEdge]) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1507
	    self clipRect:nil.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1508
	    mustRedrawBottomEdge ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1509
		self drawBottomEdge
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1510
	    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1511
	    mustRedrawRightEdge ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1512
		self drawRightEdge
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1513
	    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1514
	    self clipRect:innerClipRect
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1515
	].
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1516
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1517
	mustRepaintRight ifTrue:[
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1518
	    self redrawDeviceX:(oldWidth - margin)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1519
			     y:0
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1520
			 width:margin
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1521
			height:height.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1522
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1523
	mustRepaintBottom ifTrue:[
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1524
	    self redrawDeviceX:0
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1525
			     y:(oldHeight - margin)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1526
			 width:width
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1527
			height:margin.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1528
	].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1529
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1530
	"otherwise memorize the need for a sizeChanged message"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1531
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1532
	width := newWidth.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1533
	height := newHeight.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1534
	sameOrigin ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1535
	    originChanged := true.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1536
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1537
	extentChanged := true
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1538
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1539
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1540
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1541
cornerFromRelativeCorner
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1542
    "compute & return pixel corner from relativeCorner"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1543
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1544
    ^ self cornerFromRelativeCorner:relativeCorner
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1545
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1546
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1547
pointFromRelative:p
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1548
    "compute absolute coordinate from p"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1549
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1550
    |newX newY rel inRect bw superWidth superHeight superLeft superTop |
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1551
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1552
    bw := borderWidth.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1553
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1554
    superView isNil ifTrue:[
116
c0db6a8ab4ac *** empty log message ***
claus
parents: 113
diff changeset
  1555
	superWidth := device width + bw.      
c0db6a8ab4ac *** empty log message ***
claus
parents: 113
diff changeset
  1556
	superHeight := device height + bw.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1557
	superLeft := superTop := 0.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1558
    ] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1559
	inRect := superView viewRectangle.
116
c0db6a8ab4ac *** empty log message ***
claus
parents: 113
diff changeset
  1560
	superWidth := inRect width.
c0db6a8ab4ac *** empty log message ***
claus
parents: 113
diff changeset
  1561
	superHeight := inRect height.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1562
	superLeft := inRect left.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1563
	superTop := inRect top.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1564
    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1565
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1566
    rel := p x.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1567
    rel isInteger ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1568
	newX := rel
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1569
    ] ifFalse:[
116
c0db6a8ab4ac *** empty log message ***
claus
parents: 113
diff changeset
  1570
	newX := (rel * superWidth) asInteger + superLeft.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1571
	(bw ~~ 0) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1572
	    rel ~= 1.0 ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1573
		newX := newX - bw
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1574
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1575
	]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1576
    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1577
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1578
    rel := p y.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1579
    rel isInteger ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1580
	newY := rel
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1581
    ] ifFalse:[
116
c0db6a8ab4ac *** empty log message ***
claus
parents: 113
diff changeset
  1582
	newY := (rel * superHeight) asInteger + superTop.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1583
	(bw ~~ 0) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1584
	    rel ~= 1.0 ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1585
		newY := newY - bw
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1586
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1587
	]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1588
    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1589
    ^ newX @ newY
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1590
!
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1591
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1592
pixelCorner:corner
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1593
    "set the views corner in pixels"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1594
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1595
    |w h|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1596
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1597
    w := corner x - left.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1598
    h := corner y - top.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1599
    self pixelOrigin:(left @ top) extent:(w @ h)
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1600
!
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1601
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1602
originFromRelativeOrigin:aPoint
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1603
    "compute & return pixel origin from relativeOrigin, aPoint"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1604
123
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
  1605
    |p l t|
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1606
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1607
    p := self pointFromRelative:aPoint.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1608
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1609
    insets isNil ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1610
	^ p
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1611
    ].
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1612
    l := insets at:1.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1613
    t := insets at:2.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1614
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1615
"/  l := t := 0.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1616
"/    leftInset notNil ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1617
"/        l := leftInset
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1618
"/    ].
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1619
"/    topInset notNil ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1620
"/        t := topInset
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1621
"/    ].
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1622
    ((l ~~ 0) or:[t ~~ 0]) ifTrue:[
123
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
  1623
	^ (p x + l) @ (p y + t)
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1624
    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1625
    ^ p
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1626
!
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1627
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1628
cornerFromRelativeCorner:aPoint
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1629
    "compute & return pixel corner from a relativeCorner, aPoint"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1630
123
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
  1631
    |p r b bw|
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1632
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1633
    p := self pointFromRelative:aPoint.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1634
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1635
    bw := borderWidth.
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1636
    insets isNil ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1637
	bw == 0 ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1638
	    ^ p
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1639
	].
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1640
	^ (p x - bw) @ (p y - bw)
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1641
    ].
87
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
  1642
    r := (insets at:3) + bw.
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
  1643
    b := (insets at:4) + bw.
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1644
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1645
"/    r := b := bw.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1646
"/    rightInset notNil ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1647
"/        r := rightInset + bw
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1648
"/    ].
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1649
"/    bottomInset notNil ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1650
"/        b := bottomInset + bw
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1651
"/    ].
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1652
    ((r ~~ 0) or:[b ~~ 0]) ifTrue:[
123
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
  1653
	^ (p x - r) @ (p y - b)
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1654
    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1655
    ^ p
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1656
!
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1657
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1658
pixelOrigin:origin corner:corner
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1659
    "set the views origin and extent in pixels"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1660
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1661
    |w h|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1662
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1663
    w := corner x - origin x.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1664
    h := corner y - origin y.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1665
    self pixelOrigin:origin extent:(w @ h)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1666
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1667
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1668
extentFromRelativeExtent
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1669
    "compute & return pixel extent from relativeExtent"
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1670
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1671
    ^ self extentFromRelativeExtent:relativeExtent
42
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
  1672
!
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
  1673
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1674
extentFromRelativeExtent:aPoint
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1675
    "compute & return pixel extent from relativeExtent, aPoint"
42
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
  1676
121
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1677
    |rel newX newY inRect bw2 i|
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1678
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1679
    superView isNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1680
	inRect := 0@0 extent:device extent
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1681
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1682
	inRect := superView viewRectangle.
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1683
    ].
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1684
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1685
    bw2 := borderWidth * 2.
42
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
  1686
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1687
    rel := aPoint x.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1688
    (rel isMemberOf:Float) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1689
	newX := (rel * (inRect width + bw2)) asInteger + inRect left.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1690
	(borderWidth ~~ 0) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1691
	    newX := newX - borderWidth
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1692
	].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1693
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1694
	newX := rel
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1695
    ].
42
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
  1696
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1697
    rel := aPoint y.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1698
    (rel isMemberOf:Float) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1699
	newY := (rel * (inRect height + bw2)) asInteger + inRect top.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1700
	(borderWidth ~~ 0) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1701
	    newY := newY - borderWidth
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1702
	].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1703
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1704
	newY := rel
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1705
    ].
42
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
  1706
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1707
    insets notNil ifTrue:[
123
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
  1708
	i := insets at:1.   "top"
121
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1709
	(i  ~~ 0) ifTrue:[
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1710
	    newX := newX - i
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1711
	].
123
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
  1712
	i := insets at:3.   "left"
121
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1713
	(i  ~~ 0) ifTrue:[
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1714
	    newX := newX - i
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1715
	].
123
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
  1716
	i := insets at:2.   "right"
121
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1717
	(i ~~ 0) ifTrue:[
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1718
	    newY := newY - i
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1719
	].
123
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
  1720
	i := insets at:4.   "bottom"
121
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1721
	(i ~~ 0) ifTrue:[
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  1722
	    newY := newY - i
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1723
	].
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  1724
    ].
42
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
  1725
    ^ newX @ newY
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1726
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1727
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1728
setBorderColor
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1729
    "set my borderColor"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1730
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1731
    |id dither|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1732
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1733
    drawableId notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1734
	borderColor := borderColor on:device.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1735
	id := borderColor colorId.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1736
	id notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1737
	    device setWindowBorderColor:id in:drawableId
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1738
	] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1739
	    dither := borderColor ditherForm.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1740
	    dither notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1741
		device setWindowBorderPixmap:(dither id) in:drawableId
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1742
	    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1743
		'bad borderColor' errorPrintNewline
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1744
	    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1745
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1746
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1747
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1748
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1749
dimensionFromViewport
48194c26a46c Initial revision
claus
parents:
diff changeset
  1750
    "define my origin/extend from viewport"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1751
48194c26a46c Initial revision
claus
parents:
diff changeset
  1752
    |relW relH relX relY winW winH org ext|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1753
48194c26a46c Initial revision
claus
parents:
diff changeset
  1754
    superView notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1755
	superView window isNil ifTrue:[
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1756
"
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1757
	    v := superView.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1758
	    (v notNil and:[v window isNil]) whileTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1759
		v := v superview
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1760
	    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1761
	    v notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1762
		w := v window
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1763
	    ].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1764
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1765
"
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1766
	    winW := 1.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1767
	    winH := 1
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1768
"
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1769
	    winW := superView width.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1770
	    winH := superView height.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1771
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1772
	] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1773
	    winW := superView window width.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1774
	    winH := superView window height
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1775
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1776
	relW := (viewport width / winW) asFloat.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1777
	relH := (viewport height / winH) asFloat.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1778
	relX := (viewport left / winW) asFloat.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1779
	relY := (viewport top / winH) asFloat.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1780
	"bad coding style ... misuse other method"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1781
	relativeOrigin := (relX @ relY).
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1782
	org := self originFromRelativeOrigin.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1783
	relativeOrigin := nil.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1784
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1785
	"bad coding style ...misuse other method"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1786
	relativeExtent := (relW @ relH).
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1787
	ext := self extentFromRelativeExtent.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1788
	relativeExtent := nil.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1789
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1790
	self pixelOrigin:org extent:ext.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1791
    ]
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1792
! !
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1793
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1794
!View methodsFor:'accessing-transformation'!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1795
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1796
transformation 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1797
    "return the transformation"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1798
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1799
    |vP|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1800
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1801
    transformation isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1802
	"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1803
	 fake a transformation, if I have a non-nil window
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1804
	"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1805
	window notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1806
	    superView isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1807
		vP := (0@0 extent:self extent)
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1808
	    ] ifFalse:[
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1809
		vP := (self origin extent:self extent)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1810
	    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1811
	    ^ WindowingTransformation 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1812
				  window:window
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1813
				  viewport:vP
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1814
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1815
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1816
    ^ transformation
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1817
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1818
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1819
viewRectangle
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1820
    "return the inside area"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1821
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1822
    |m2|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1823
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1824
    innerClipRect notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1825
	^ innerClipRect
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1826
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1827
    m2 := margin + margin.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1828
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1829
    ^ (margin @ margin) extent:((width - m2) @ (height - m2))
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1830
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1831
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1832
window
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1833
    "return my window (i.e. logical coordinate space).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1834
     If there is no window, return the extent."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1835
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1836
    window isNil ifTrue:[^ width @ height].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1837
    ^ window
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1838
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1839
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1840
window:aRectangle
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1841
    "define my window (i.e. logical coordinate space)"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1842
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1843
    window := aRectangle.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1844
    subViews notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1845
	subViews do:[:s |
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1846
	    s superViewChangedSize
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1847
	]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1848
    ]
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1849
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1850
"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1851
    viewport isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1852
	viewport := aRectangle.
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  1853
    ].
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1854
"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1855
"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1856
    superView notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1857
	self superViewChangedSize
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1858
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1859
	originChanged := true.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1860
	extentChanged := true
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1861
    ]
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1862
"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1863
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1864
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1865
viewOrigin
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1866
    "return the viewOrigin; thats the coordinate of the contents 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1867
     which is shown topLeft in the view 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1868
     (i.e. the origin of the visible part of the contents)."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1869
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1870
    transformation isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1871
	^ 0@0
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1872
    ].
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1873
    ^ transformation translation negated
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1874
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1875
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1876
setViewOrigin:aPoint
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1877
    "set the viewOrigin - i.e. virtually scroll without redrawing"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1878
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1879
    |p|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1880
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1881
    p := aPoint negated.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1882
    transformation isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1883
	transformation := WindowingTransformation scale:1 translation:p 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1884
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1885
	transformation translation:p 
60
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  1886
    ].
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1887
    clipRect notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1888
	self setInnerClip.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1889
    ].
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1890
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1891
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1892
viewport:aRectangle
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1893
    "define my extend in my superviews coordinate-system."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1894
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1895
"/    |relW relH relX relY winW winH|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1896
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1897
    viewport := aRectangle.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1898
    self dimensionFromViewport
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1899
"/
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1900
"/    superView notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1901
"/        superView window isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1902
"/            winW := 1.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1903
"/            winH := 1
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1904
"/        ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1905
"/            winW := superView window width.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1906
"/            winH := superView window height
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1907
"/        ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1908
"/        relW := (aRectangle width / winW) asFloat.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1909
"/        relH := (aRectangle height / winH) asFloat.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1910
"/        relX := (aRectangle left / winW) asFloat.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1911
"/        relY := (aRectangle top / winH) asFloat.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1912
"/        self origin:(relX @ relY) extent:(relW @ relH)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1913
"/    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1914
"/
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1915
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1916
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1917
window:aRectangle viewport:vRect
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1918
    window := aRectangle.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1919
    self viewport:vRect.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1920
    subViews notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1921
	subViews do:[:s |
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1922
	    s superViewChangedSize
89
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  1923
	]
20
ab35d92b9a4b *** empty log message ***
claus
parents: 15
diff changeset
  1924
    ]
60
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  1925
!
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  1926
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1927
scale
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1928
    "return the scale factor (as point) of the transformation"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1929
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1930
    transformation isNil ifTrue:[^ 1].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1931
    ^ transformation scale
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1932
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1933
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1934
scale:aPoint
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1935
    "set the scale factor of the transformation"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1936
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1937
    transformation isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1938
	aPoint = 1 ifTrue:[^ self].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1939
	transformation := WindowingTransformation scale:aPoint translation:0
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1940
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1941
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1942
    transformation scale:aPoint.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1943
    self computeInnerClip
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1944
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1945
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1946
xOriginOfContents
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1947
    "return the x coordinate of the viewOrigin in pixels; 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1948
     used by scrollBars to compute thumb position within the document."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1949
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1950
    ^ self viewOrigin x
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1951
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1952
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1953
yOriginOfContents
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1954
    "return the y coordinate of the viewOrigin in pixels; 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1955
     used by scrollBars to compute thumb position within the document."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1956
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1957
    ^ self viewOrigin y
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1958
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1959
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1960
heightOfContents
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1961
    "return the height of the contents in logical units 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1962
     - defaults to views visible area here.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1963
    This method MUST be redefined in all view classess which are
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1964
    going to be scrolled AND show data which has different size than
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1965
    the view. For example, a view showing A4-size documents should return
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1966
    the number of vertical pixels such a document has on this device.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1967
    A view showing a bitmap of height 1000 should return 1000.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1968
    If not redefined, scrollbars have no way of knowing the actual size
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1969
    of the contents being shown. This is called by scrollBars to compute
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1970
    the relative height of the document vs. the views actual size.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1971
    The value returned here must be based on a scale of 1, since users
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1972
    of this will scale as appropriate."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1973
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1974
    ^ self innerHeight max:(self maxSubViewBottom)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1975
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1976
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1977
widthOfContents
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1978
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1979
    ^ self innerWidth max:(self maxSubViewRight)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1980
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1981
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1982
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1983
maxSubViewBottom 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1984
"/    subViews isNil ifTrue:[^ 0].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1985
"/    ^ subViews inject:0 into:[:maxSoFar :sub | (sub top + sub height) max:maxSoFar].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1986
      ^ 0
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1987
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1988
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1989
maxSubViewRight 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1990
"/    subViews isNil ifTrue:[^ 0].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1991
"/    ^ subViews inject:0 into:[:maxSoFar :sub | (sub left + sub width) max:maxSoFar].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1992
    ^ 0
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1993
! !
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1994
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1995
!View methodsFor:'accessing misc'!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1996
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1997
clipRect:aRectangle
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1998
    "set the clipping rectangle for drawing (in logical coordinates);
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  1999
     a nil argument turn off clipping (i.e. whole view is drawable).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2000
     Redefined to care for any margin."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2001
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2002
    |x y w h|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2003
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2004
    aRectangle isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2005
	clipRect isNil ifTrue:[^ self].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2006
	gcId notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2007
	    device noClipIn:gcId
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2008
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2009
    ] ifFalse:[
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2010
	clipRect notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2011
	    (clipRect = aRectangle) ifTrue:[^ self]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2012
	].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2013
	gcId notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2014
	    x := aRectangle left.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2015
	    y := aRectangle top.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2016
	    w := aRectangle width.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2017
	    h := aRectangle height.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2018
	    transformation notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2019
		x := transformation applyToX:x.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2020
		y := transformation applyToY:y.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2021
		w := transformation applyScaleX:w.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2022
		h := transformation applyScaleY:h.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2023
	    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2024
	    (x isMemberOf:SmallInteger) ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2025
		w := w + (x - x truncated).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2026
		x := x truncated
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2027
	    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2028
	    (y isMemberOf:SmallInteger) ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2029
		h := h + (y - y truncated).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2030
		y := y truncated
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2031
	    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2032
	    (w isMemberOf:SmallInteger) ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2033
		w := w truncated + 1
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2034
	    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2035
	    (h isMemberOf:SmallInteger) ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2036
		h := h truncated + 1
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2037
	    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2038
	    x < margin ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2039
		x := margin.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2040
	    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2041
	    y < margin ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2042
		y := margin.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2043
	    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2044
	    x + w - 1 >= (width-margin) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2045
		w := width - margin - x
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2046
	    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2047
	    y + h - 1 >= (height-margin) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2048
		h := height - margin - y
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2049
	    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2050
	    device setClipX:x y:y width:w height:h in:gcId
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2051
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2052
    ].
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2053
    clipRect := aRectangle
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2054
! !
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2055
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2056
!View methodsFor:'ST-80 compatibility'!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2057
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2058
sensor
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2059
    "return the views sensor"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2060
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2061
    windowGroup notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2062
	^ windowGroup sensor.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2063
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2064
    ^ nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2065
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2066
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2067
update:aspect
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2068
    "an update request - ignored here. Can be redefined in subclasses"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2069
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2070
    ^ self
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2071
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2072
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2073
on:aModel aspect:aspect change:change list:list menu:menu
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2074
    "ST-80 compatibility"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2075
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2076
    aspectSymbol := aspect.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2077
    changeSymbol := change.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2078
    menuSymbol := menu.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2079
    self model:aModel
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2080
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2081
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2082
update
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2083
    "an update request - ignored here. Can be redefined in subclasses."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2084
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2085
    ^ self
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2086
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2087
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2088
update:aspect with:aParameter from:changedObject
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2089
    "an update request"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2090
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2091
    aspect == #sizeOfView ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2092
	"one of the views we depend on changed its size"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2093
	^ self superViewChangedSize.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2094
    ].
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2095
    ^super update:aspect with:aParameter from:changedObject
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2096
! !
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2097
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2098
!View methodsFor:'accessing-misc'!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2099
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2100
shown
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2101
    "return true if the view is shown; false if hidden"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2102
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2103
    ^ shown
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2104
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2105
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2106
inputOnly
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2107
    "return true, if this view is an input-only view;
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2108
     input only views are transparent and can be layed on top of a view to
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2109
     catch its input"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2110
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2111
    ^ false
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2112
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2113
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2114
createOnTop
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2115
    "return true, if this view should be put on top (raised) automatically.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2116
     usually this is true for alertBoxes etc."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2117
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2118
    ^ false
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2119
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2120
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2121
is3D
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2122
    "return true, if my style is some kind of 3D style - will change"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2123
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2124
    ^ StyleSheet is3D
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2125
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2126
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2127
raise
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2128
    "bring to front"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2129
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2130
    drawableId isNil ifTrue:[self create].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2131
    device raiseWindow:drawableId
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2132
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2133
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2134
viewGravity:gravity
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2135
    "set the viewGravity - thats the direction where the view will move
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2136
     when the superView is resized."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2137
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2138
    viewGravity ~~ gravity ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2139
	viewGravity := gravity.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2140
	drawableId notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2141
	    device setWindowGravity:gravity in:drawableId
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2142
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2143
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2144
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2145
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2146
viewGravity
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2147
    "return the viewGravity - thats the direction where the view will move
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2148
     when the superView is resized."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2149
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2150
    ^ viewGravity
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2151
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2152
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2153
hidden:aBoolean
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2154
    "if the argument is true, the receiver view will not
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2155
     be realized automatically when superview is realized"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2156
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2157
    hidden := aBoolean
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2158
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2159
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2160
bitGravity
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2161
    "return the bitGravity - thats the direction where the contents will move
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2162
     when the the view is resized."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2163
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2164
    ^ bitGravity
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2165
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2166
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2167
bitGravity:gravity
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2168
    "set the bitGravity - thats the direction where the contents will move
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2169
     when the view is resized."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2170
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2171
    bitGravity ~~ gravity ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2172
	bitGravity := gravity.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2173
	drawableId notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2174
	    device setBitGravity:gravity in:drawableId
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2175
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2176
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2177
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2178
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2179
canDrop:anObjectOrCollection
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2180
    "return true, if anObjectOrCollection can be
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2181
     dropped in the receiver. This method should be
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2182
     redefined in views which can take objects"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2183
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2184
    ^ false
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2185
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2186
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2187
isCollapsed
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2188
    "ST80 compatibility: return true if the view is not shown (i.e. iconified)"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2189
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2190
    ^ shown not
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2191
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2192
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2193
hidden
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2194
    "return true, if the view does not want to be realized
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2195
     automatically when superview is realized"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2196
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2197
    ^ hidden
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2198
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2199
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2200
lower
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2201
    "bring to back"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2202
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2203
    drawableId isNil ifTrue:[self create].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2204
    device lowerWindow:drawableId
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2205
! !
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2206
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2207
!View methodsFor:'initialization'!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2208
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2209
defaultControllerClass
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2210
    ^ nil "/ Controller
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2211
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2212
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2213
initEvents
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2214
    "will be sent by create - can be redefined by subclasses to enable
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2215
     view events"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2216
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2217
    ^ self
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2218
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2219
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2220
initialize
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2221
    "initialize all state of the view - usually redefined in subclasses,
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2222
     but always doing a 'super initialize'. Each class should setup its
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2223
     locals - and not forget the others.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2224
     View setup is separated into two parts, the general setup done here
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2225
     and the style specific setup in initStyle. Each view should be prepared
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2226
     for a stylechange by being sent another initStyle with a new style value.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2227
     (in this case, it should set all of its style-dependent things, but
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2228
      leave the state and contents as-is)"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2229
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2230
    |ext controllerClass|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2231
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2232
    super initialize.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2233
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2234
    font := DefaultFont.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2235
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2236
    shown := hidden := realized := false.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2237
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2238
    "fill in some defaults - some of them are usually redefined in subclasses
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2239
     initialize methods"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2240
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2241
    name := self class name asString asLowercaseFirst.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2242
    ext := self class defaultExtent.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2243
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2244
    level := 0.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2245
    margin := 0.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2246
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2247
    resources := self class classResources.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2248
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2249
    self initStyle.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2250
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2251
    left := 0.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2252
    top := 0.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2253
    width := ext x.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2254
    height := ext y.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2255
"/    leftInset := 0.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2256
"/    topInset := 0.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2257
"/    rightInset := 0.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2258
"/    bottomInset := 0.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2259
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2260
    viewOrigin := 0@0.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2261
    originChanged := extentChanged := false.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2262
    bitGravity := nil.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2263
    viewGravity := nil.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2264
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2265
    controllerClass := self defaultControllerClass.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2266
    controllerClass notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2267
	controller := controllerClass new.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2268
	controller view:self.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2269
	model notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2270
	    controller model:model
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2271
	]
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2272
    ].
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2273
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2274
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2275
initStyle
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2276
    "this method sets up all style dependent things"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2277
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2278
    "
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2279
     when coming here the first time, we read the styleSheet
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2280
     and keep the values in fast class variables
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2281
    "
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2282
    StyleSheet isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2283
	self class updateStyleCache
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2284
    ].
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2285
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2286
    style := DefaultStyle.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2287
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2288
    borderWidth := DefaultBorderWidth.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2289
    borderWidth isNil ifTrue:[borderWidth := 1].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2290
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2291
    viewBackground := DefaultViewBackgroundColor "on:device".
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2292
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2293
    DefaultLightColor notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2294
	lightColor := DefaultLightColor.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2295
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2296
	device hasGreyscales ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2297
	    DefaultLightColor := lightColor := viewBackground lightened.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2298
	] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2299
	    "
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2300
	     this seems strange: on B&W light color is darker than
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2301
	     normal viewBackground (White) to make the boundary of
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2302
	     the view visible
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2303
	    "
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2304
	    lightColor := Color grey:50
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2305
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2306
    ].
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2307
    DefaultShadowColor notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2308
	shadowColor := DefaultShadowColor.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2309
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2310
	shadowColor := Black
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2311
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2312
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2313
    lightColor := lightColor "on:device".
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2314
    shadowColor := shadowColor "on:device".
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2315
    borderColor := DefaultBorderColor " on:device".
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2316
    font := DefaultFont on:device.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2317
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2318
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2319
prepareForReinit
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2320
    super prepareForReinit.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2321
    windowGroup notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2322
	windowGroup reinitialize
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2323
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2324
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2325
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2326
reinitialize
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2327
    "this is called right snapIn"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2328
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2329
    |myController|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2330
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2331
    "if I have already been reinited - return"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2332
    drawableId notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2333
	^ self
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2334
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2335
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2336
    "
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2337
     superView must be there, first
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2338
    "
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2339
    superView notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2340
	superView id isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2341
	    superView reinitialize
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2342
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2343
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2344
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2345
    myController := controller.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2346
    controller := nil.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2347
    self recreate.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2348
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2349
    "if I was mapped, do it again"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2350
    realized ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2351
	"only remap if I have a superview - otherwise, I might be
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2352
	 a hidden iconView or menu ..."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2353
	superView notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2354
"/            shown ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2355
		device mapView:self id:drawableId iconified:false
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2356
			   atX:left y:top width:width height:height
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2357
"/            ].
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2358
	].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2359
    ].
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2360
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2361
    "restore controller"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2362
    controller := myController
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2363
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2364
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2365
reinitStyle
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2366
    "this method is called for a style change"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2367
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2368
    |t|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2369
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2370
    self initStyle.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2371
    drawableId notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2372
	"force a change"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2373
	t := borderWidth. borderWidth := nil. self borderWidth:t.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2374
	t := viewBackground. viewBackground := nil. self viewBackground:t.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2375
	self clear.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2376
	self redraw
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2377
    ].
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2378
! !
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2379
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2380
!View methodsFor:'accessing-hierarchy'!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2381
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2382
superView:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2383
    "set my superView to be aView"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2384
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2385
    superView := aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2386
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2387
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2388
superView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2389
    "return my superView"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2390
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2391
    ^ superView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2392
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2393
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2394
subViews
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2395
    "return the collection of subviews"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2396
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2397
    ^ subViews
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2398
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2399
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2400
topView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2401
    "return the topView - thats the one with no superview"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2402
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2403
    |v|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2404
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2405
    v := self.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2406
    [v notNil] whileTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2407
	v superView isNil ifTrue:[^ v].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2408
	v := v superView
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2409
    ].
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2410
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2411
    ^ nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2412
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2413
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2414
subViews:aListOfViews
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2415
    "set the collection of subviews"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2416
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2417
    subViews := aListOfViews.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2418
    subViews notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2419
	subViews do:[:view |
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2420
	    view superView:self
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2421
	]
89
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  2422
    ]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2423
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  2424
86
032006651226 *** empty log message ***
claus
parents: 83
diff changeset
  2425
!View methodsFor:'event handling'!
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2426
48194c26a46c Initial revision
claus
parents:
diff changeset
  2427
exposeX:x y:y width:w height:h
48194c26a46c Initial revision
claus
parents:
diff changeset
  2428
    "a low level redraw event from device
48194c26a46c Initial revision
claus
parents:
diff changeset
  2429
      - let subclass handle the redraw and take care of edges here"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2430
89
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  2431
    |leftEdge topEdge rightEdge botEdge anyEdge nx ny nw nh old|
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2432
48194c26a46c Initial revision
claus
parents:
diff changeset
  2433
    nw := w.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2434
    nh := h.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2435
    nx := x.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2436
    ny := y.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2437
48194c26a46c Initial revision
claus
parents:
diff changeset
  2438
    anyEdge := false.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2439
83
597bdb33e832 *** empty log message ***
claus
parents: 82
diff changeset
  2440
    "
89
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  2441
     check if there is a need to draw an edge (i.e. if margin is hit)
83
597bdb33e832 *** empty log message ***
claus
parents: 82
diff changeset
  2442
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2443
    (margin ~~ 0) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2444
	leftEdge := false.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2445
	topEdge := false.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2446
	rightEdge := false.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2447
	botEdge := false.
83
597bdb33e832 *** empty log message ***
claus
parents: 82
diff changeset
  2448
	transformation notNil ifTrue:[
597bdb33e832 *** empty log message ***
claus
parents: 82
diff changeset
  2449
	    "
597bdb33e832 *** empty log message ***
claus
parents: 82
diff changeset
  2450
	     need device coordinates for this test
597bdb33e832 *** empty log message ***
claus
parents: 82
diff changeset
  2451
	    "
597bdb33e832 *** empty log message ***
claus
parents: 82
diff changeset
  2452
	    nx := transformation applyToX:nx.
597bdb33e832 *** empty log message ***
claus
parents: 82
diff changeset
  2453
	    ny := transformation applyToY:ny.
597bdb33e832 *** empty log message ***
claus
parents: 82
diff changeset
  2454
	    nw := transformation applyScaleX:nw.
87
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
  2455
	    nh := transformation applyScaleY:nh.
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
  2456
	].
89
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  2457
	"
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  2458
	 adjust expose rectangle, to exclude the margin.
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  2459
	 Care for rounding errors ...
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  2460
	"
87
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
  2461
	(nx isMemberOf:SmallInteger) ifFalse:[
89
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  2462
	    old := nx.
87
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
  2463
	    nx := nx truncated.
89
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  2464
	    nw := nw + (nx - old).
87
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
  2465
	].
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
  2466
	(ny isMemberOf:SmallInteger) ifFalse:[
89
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  2467
	    old := ny.
87
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
  2468
	    ny := ny truncated.
89
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  2469
	    nh := nh + (ny - old).
87
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
  2470
	].
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
  2471
	(nw isMemberOf:SmallInteger) ifFalse:[
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
  2472
	    nw := nw truncated + 1
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
  2473
	].
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
  2474
	(nh isMemberOf:SmallInteger) ifFalse:[
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
  2475
	    nh := nh truncated + 1
83
597bdb33e832 *** empty log message ***
claus
parents: 82
diff changeset
  2476
	].
89
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  2477
	(nx < margin) ifTrue:[
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  2478
	    old := nx.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2479
	    nx := margin.
89
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  2480
	    nw := nw - (nx - old).
87
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
  2481
	    leftEdge := anyEdge := true.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2482
	].
89
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  2483
	((nx + nw - 1) >= (width - margin)) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2484
	    nw := (width - margin - nx).
87
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
  2485
	    rightEdge := anyEdge := true.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2486
	].
89
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  2487
	(ny < margin) ifTrue:[
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  2488
	    old := ny.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2489
	    ny := margin.
89
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  2490
	    nh := nh - (ny - old).
87
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
  2491
	    topEdge := anyEdge := true.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2492
	].
89
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  2493
	((ny + nh - 1) >= (height - margin)) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2494
	    nh := (height - margin - ny).
87
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
  2495
	    botEdge := anyEdge := true.
83
597bdb33e832 *** empty log message ***
claus
parents: 82
diff changeset
  2496
	].
597bdb33e832 *** empty log message ***
claus
parents: 82
diff changeset
  2497
	transformation notNil ifTrue:[
597bdb33e832 *** empty log message ***
claus
parents: 82
diff changeset
  2498
	    "
597bdb33e832 *** empty log message ***
claus
parents: 82
diff changeset
  2499
	     need logical coordinates for redraw
597bdb33e832 *** empty log message ***
claus
parents: 82
diff changeset
  2500
	    "
597bdb33e832 *** empty log message ***
claus
parents: 82
diff changeset
  2501
	    nx := transformation applyInverseToX:nx.
597bdb33e832 *** empty log message ***
claus
parents: 82
diff changeset
  2502
	    ny := transformation applyInverseToY:ny.
597bdb33e832 *** empty log message ***
claus
parents: 82
diff changeset
  2503
	    nw := transformation applyInverseScaleX:nw.
87
b64ce99ebeaa last version before big scrolling change
claus
parents: 86
diff changeset
  2504
	    nh := transformation applyInverseScaleY:nh.
83
597bdb33e832 *** empty log message ***
claus
parents: 82
diff changeset
  2505
	].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2506
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2507
89
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  2508
    "
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  2509
     redraw inside area
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  2510
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2511
    self redrawX:nx y:ny width:nw height:nh.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2512
89
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  2513
    "
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  2514
     redraw edge(s)
ea2bf46eb669 *** empty log message ***
claus
parents: 87
diff changeset
  2515
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2516
    anyEdge ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2517
	self clipRect:nil.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2518
	(topEdge and:[leftEdge and:[botEdge and:[rightEdge]]]) ifTrue:[
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2519
	    self drawEdges
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2520
	] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2521
	    topEdge ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2522
		self drawTopEdge
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2523
	    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2524
	    leftEdge ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2525
		self drawLeftEdge
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2526
	    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2527
	    botEdge ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2528
		self drawBottomEdge
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2529
	    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2530
	    rightEdge ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2531
		self drawRightEdge
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2532
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2533
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2534
	self clipRect:innerClipRect
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2535
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2536
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2537
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2538
superViewMapped
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2539
    "my superview was unmapped"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2540
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2541
    realized ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2542
	shown := true.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2543
	subViews notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2544
	    subViews do:[:v |
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2545
		v superViewMapped
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2546
	    ]
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2547
	]
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2548
    ].
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2549
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2550
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2551
configureX:x y:y width:newWidth height:newHeight
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2552
    "my size has changed by window manager action"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2553
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2554
    |how anyEdge mustRedrawBottomEdge mustRedrawRightEdge|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2555
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2556
    left := x.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2557
    top := y.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2558
    ((width ~~ newWidth) or:[height ~~ newHeight]) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2559
	realized ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2560
	    width := newWidth.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2561
	    height := newHeight.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2562
	    extentChanged := true.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2563
	    ^ self
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2564
	].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2565
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2566
	((newWidth <= width) and:[newHeight <= height]) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2567
	    how := #smaller
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2568
	].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2569
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2570
	level ~~ 0 ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2571
	    mustRedrawBottomEdge := newHeight < height.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2572
	    mustRedrawRightEdge := newWidth < width.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2573
	    anyEdge := mustRedrawBottomEdge or:[mustRedrawRightEdge]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2574
	] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2575
	    anyEdge := false
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2576
	].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2577
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2578
	width := newWidth.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2579
	height := newHeight.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2580
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2581
	"recompute inner-clip if needed"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2582
	self setInnerClip.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2583
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2584
	"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2585
	 must first process pending exposes;
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2586
	 otherwise, those may be drawn at a wrong position
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2587
	"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2588
	windowGroup notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2589
	    windowGroup processExposeEvents
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2590
	].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2591
	self sizeChanged:how.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2592
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2593
	(anyEdge and:[shown]) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2594
	    self clipRect:nil.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2595
	    mustRedrawBottomEdge ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2596
		self drawBottomEdge
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2597
	    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2598
	    mustRedrawRightEdge ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2599
		self drawRightEdge
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2600
	    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2601
	    self clipRect:innerClipRect
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2602
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2603
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2604
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2605
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2606
superViewChangedSize
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2607
    "my superView has changed size; if I have relative
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2608
     origin/extent or blocks to evaluate, do it now .."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2609
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2610
    |oldWidth oldHeight oldTop oldLeft newExt newOrg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2611
     winSuper newWidth newHeight newLeft newTop newCorner
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2612
     superWidth superHeight superWinWidth superWinHeight|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2613
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2614
    oldWidth := width.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2615
    oldHeight := height.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2616
    oldTop := top.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2617
    oldLeft := left.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2618
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2619
    viewport notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2620
	"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2621
	 if this view has a viewPort, resize a la st-80
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2622
	 this will vanish - dont use it.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2623
	"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2624
	superView isNil ifTrue:[^ self].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2625
	winSuper := superView window.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2626
	winSuper isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2627
	    "take pixel size as window"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2628
	    winSuper := 0@0 extent:(superView width@superView height)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2629
	].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2630
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2631
	superWidth := superView width.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2632
	superHeight := superView height.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2633
	superWinWidth := winSuper width.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2634
	superWinHeight := winSuper height.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2635
	newLeft := (viewport left - winSuper left) * superWidth // superWinWidth.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2636
	newTop := (viewport top - winSuper top) * superHeight // superWinHeight.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2637
	newWidth := superWidth * viewport width // superWinWidth.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2638
	newHeight := superHeight * viewport height // superWinHeight.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2639
	self pixelOrigin:(newLeft @ newTop).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2640
	self pixelExtent:(newWidth @ newHeight).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2641
	^ self
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  2642
    ].
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  2643
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2644
    newOrg := self computeOrigin.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2645
    newExt := self computeExtent.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2646
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2647
    newOrg notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2648
	((newOrg x == oldLeft) and:[newOrg y == oldTop]) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2649
	    newOrg := nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2650
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2651
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2652
    newExt notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2653
	((newExt x == width) and:[newExt y == height]) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2654
	    newExt := nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2655
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2656
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2657
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2658
    newExt isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2659
	newOrg notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2660
	    self pixelOrigin:newOrg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2661
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2662
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2663
	newOrg isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2664
	    self pixelExtent:newExt
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2665
	] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2666
	    self pixelOrigin:newOrg extent:newExt
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2667
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2668
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2669
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2670
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2671
mapped
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2672
    "the view has been mapped (by some outside
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2673
     action - i.e. window manager de-iconified me)"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2674
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  2675
    "
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2676
     the old code was:
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2677
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2678
	realized := true.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2679
	shown := true.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2680
	...
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2681
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2682
     this created a race condition, if the view was
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2683
     realized and shortly after unrealized - before the mapped event
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2684
     arrived. This lead to shown being set to true even thought the
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2685
     view was not. Boy - that was a bad one (hard to reproduce and hard to find).
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  2686
    "
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2687
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2688
    realized ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2689
	shown := true.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2690
	"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2691
	 backed views will not get expose events - have
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2692
	 to force a redraw here to get things drawn into
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2693
	 backing store.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2694
	"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2695
	backed ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2696
	    self redraw
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2697
	].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2698
	subViews notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2699
	    subViews do:[:v |
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2700
		v superViewMapped
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2701
	    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2702
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2703
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2704
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2705
48194c26a46c Initial revision
claus
parents:
diff changeset
  2706
buttonPress:button x:x y:y
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2707
    "button was pressed - if its the middle button 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2708
     and there is a middleButtonMenu, show it.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2709
     If both a model and a menuSelector is is defined, ask the model for
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2710
     the menu and launch it. The menu is supposed to return an actionSelector
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2711
     which in turn is sent to the model."
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2712
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2713
    |menu actionSelector|
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2714
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2715
    components notNil ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2716
	components do:[:aComponent |
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2717
	    |thisFrame|
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2718
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2719
	    thisFrame := aComponent frame.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2720
	    (thisFrame containsPointX:x y:y) ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2721
		aComponent buttonPress:button x:x - thisFrame left
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2722
					      y:y - thisFrame top.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2723
		^ self
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2724
	    ]
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2725
	]
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2726
    ].
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2727
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2728
    ((button == 2) or:[button == #menu]) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2729
	"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2730
	 try ST-80 style menus first:
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2731
	 if there is a model, and a menuSymbol is defined,
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2732
	 ask model for the menu and launch that if non-nil.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2733
	"
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2734
	(model notNil 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2735
	and:[menuSymbol notNil
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2736
	and:[menuSymbol isSymbol]]) ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2737
	    "
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2738
	     ask model for the menu
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2739
	    "
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2740
	    menu := model perform:menuSymbol.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2741
	    menu notNil ifTrue:[
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2742
		"
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2743
		 got one, launch the menu. It is supposed
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2744
		 to return an actionSelector.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2745
		"
110
60c08d82e209 *** empty log message ***
claus
parents: 109
diff changeset
  2746
		menu receiver isNil ifTrue:[
60c08d82e209 *** empty log message ***
claus
parents: 109
diff changeset
  2747
		    menu receiver: model
60c08d82e209 *** empty log message ***
claus
parents: 109
diff changeset
  2748
		].
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2749
		actionSelector := menu startUp.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2750
		(actionSelector notNil
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2751
		and:[actionSelector isSymbol]) ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2752
		    model perform:actionSelector
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2753
		]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2754
	    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2755
	    ^ self
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2756
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2757
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2758
    super buttonPress:button x:x y:y
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2759
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2760
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2761
unmapped
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2762
    "the view has been unmapped (by some outside
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2763
     action - i.e. window manager iconified me)"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2764
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2765
    shown := false.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2766
    subViews notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2767
	subViews do:[:v |
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2768
	    v superViewUnmapped
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2769
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2770
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2771
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2772
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2773
coveredBy:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2774
    "the receiver has been covered by another view;
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2775
     we are not interrested in that here (but see modalBox for more)."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2776
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2777
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2778
sizeChanged:how
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2779
    "tell subviews if I change size.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2780
     How is either #smaller, #larger or nil, and is used to control the order,
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2781
     in which subviews are notified (possibly reducing redraw activity)"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2782
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2783
    window notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2784
	"compute new transformation"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2785
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2786
    subViews notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2787
	(how isNil "false" 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2788
	or:[how == #smaller]) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2789
	    subViews do:[:view |
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2790
		view superViewChangedSize
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2791
	    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2792
	] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2793
	    "doing it reverse speeds up resizing - usually subviews
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2794
	     are created from top-left to bottom-right; therefore
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2795
	     bottom-right views will be moved/resized first, then top-left ones;
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2796
	     this avoids multiple redraws of subviews"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2797
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2798
	    subViews reverseDo:[:view |
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2799
		view superViewChangedSize
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2800
	    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2801
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2802
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2803
    self changed:#sizeOfView with:how.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2804
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2805
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2806
superViewUnmapped
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2807
    "my superView was unmapped"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2808
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2809
    shown := false.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2810
    subViews notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2811
	subViews do:[:v |
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2812
	    v superViewUnmapped
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2813
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2814
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2815
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2816
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2817
reparented
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2818
    "the view has changed its parent by some outside
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2819
     action - i.e. window manager has added a frame.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2820
     nothing done here"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2821
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2822
    ^ self
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2823
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2824
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2825
terminate
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2826
    "window manager wants me to go away;
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2827
     - notice, that not all window managers are nice enough to 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2828
       send this event, but simply destroy the view instead.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2829
     Can be redefined in subclasses to do whatever cleanup is 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2830
     required."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2831
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2832
    ^ self destroy
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2833
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2834
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2835
focusIn
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2836
    "got keyboard focus"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2837
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2838
    self showFocus
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2839
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2840
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2841
keyPress:key x:x y:y
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2842
    "a key has been pressed.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2843
     if there is a keyboardHandler, pass input to him;
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2844
     otherwise forward it to the superview, if there is any."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2845
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2846
    components notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2847
	components do:[:aComponent |
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2848
	    |thisFrame|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2849
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2850
	    thisFrame := aComponent frame.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2851
	    (thisFrame containsPointX:x y:y) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2852
		aComponent keyPress:key x:x - thisFrame left
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2853
					y:y - thisFrame top.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2854
		^ self
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2855
	    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2856
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2857
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2858
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2859
    "
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2860
     allow forwarding events to the keyboardhandler
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2861
    "
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2862
    keyboardHandler notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2863
	^ keyboardHandler keyPress:key x:x y:y
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2864
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2865
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2866
    "
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2867
     mhmh: consider this a kludge:
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2868
     if there is a key-event in a subview, AND the key is not handled 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2869
     in the subview (such as SHIFT_L), AND the subviews topview has set
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2870
     a keyboardHandler, which is the original subview, 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2871
     THEN we are cought in a recursive loop as:
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2872
       subview keyPress -> superView keyPress -> handler(==subview) keyPress
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2873
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2874
     the following kludge checks for this, and breaks out.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2875
     Do you have any better idea ?
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2876
    "
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2877
    thisContext isRecursive ifTrue:[^ self].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2878
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2879
    superView notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2880
	superView keyPress:key x:x y:y
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2881
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2882
	super keyPress:key x:x y:y
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2883
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2884
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2885
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2886
focusOut
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2887
    "lost keyboard focus"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2888
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2889
    self showNoFocus
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2890
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2891
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2892
visibilityChange:how
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2893
    "the visibility of the view has changed (by some outside
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2894
     action - i.e. window manager rearranged things).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2895
     Using this knowledge avoids useless redraw in obsucred views."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2896
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2897
    how == #fullyObscured ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2898
	shown := false
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2899
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2900
	shown := true.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2901
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2902
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2903
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2904
destroyed
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2905
    "view has been destroyed by someone else (usually window system)"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2906
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2907
    shown := false.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2908
    super destroyed
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2909
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2910
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2911
saveAndTerminate
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2912
    "window manager wants me to save and go away; 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2913
     - notice, that not all window managers are nice enough to 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2914
       send this event, but simply destroy the view instead.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2915
     Can be redefined in subclasses to do whatever is required
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2916
     to prepare for restart."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2917
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2918
    ^ self destroy
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2919
! !
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2920
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2921
!View methodsFor:'accessing-bg & border'!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2922
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2923
margin
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2924
    "return my margin - this is usually the level,
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2925
     but can be more for some views"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2926
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2927
    ^ margin
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2928
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2929
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2930
borderWidth
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2931
    "return my borderWidth"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2932
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2933
    ^ borderWidth
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2934
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2935
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2936
keyboardHandler:someOne
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2937
    "set my keyboardHandler"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2938
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2939
    keyboardHandler := someOne
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2940
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2941
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2942
borderWidth:aNumber
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2943
    "set my borderWidth"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2944
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2945
    (aNumber ~~ borderWidth) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2946
	borderWidth := aNumber.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2947
	drawableId notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2948
	    device setWindowBorderWidth:aNumber in:drawableId
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2949
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2950
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2951
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2952
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2953
level:aNumber
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2954
    "set my level relative to superView (3D)"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2955
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2956
    |oldMargin how|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2957
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2958
    (aNumber ~~ level) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2959
	self is3D ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2960
	    level := aNumber.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2961
	    oldMargin := margin.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2962
	    margin := level abs.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2963
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2964
	    realized ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2965
		margin ~~ oldMargin ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2966
		    (margin > oldMargin) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2967
			how := #smaller
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2968
		    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2969
			how := #larger
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2970
		    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2971
		    self sizeChanged:how.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2972
		    self setInnerClip.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2973
		].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2974
		shown ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2975
		    self redrawEdges
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2976
		]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2977
	    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2978
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2979
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2980
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2981
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2982
viewBackground:something
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2983
    "set the viewBackground to something, a color, image or form.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2984
     If its a color and we run on a color display, also set shadow and light
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2985
     colors - this means, that a red view will get light-red and dark-red
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2986
     edges."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2987
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2988
    something isColor ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2989
	device hasGreyscales ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2990
	    shadowColor := something darkened.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2991
	    lightColor := something lightened
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2992
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2993
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2994
    super viewBackground:something
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2995
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2996
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2997
heightIncludingBorder
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2998
    "return my height including border"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  2999
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3000
    ^ height + (2*borderWidth)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3001
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3002
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3003
borderColor
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3004
    "return my borderColor"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3005
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3006
    ^ borderColor
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3007
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3008
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3009
borderColor:aColor
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3010
    "set my borderColor"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3011
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3012
    (aColor ~~ borderColor) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3013
	borderColor := aColor.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3014
	drawableId notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3015
	    self setBorderColor
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3016
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3017
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3018
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3019
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3020
borderShape:aForm
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3021
    "set the borderShape to aForm"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3022
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3023
    borderShape := aForm.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3024
    drawableId notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3025
	device setWindowBorderShape:(aForm id) in:drawableId
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3026
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3027
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3028
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3029
viewShape:aForm
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3030
    "set the viewShape to aForm"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3031
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3032
    viewShape := aForm.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3033
    drawableId notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3034
	device setWindowShape:(aForm id) in:drawableId
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3035
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3036
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3037
121
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  3038
processName
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  3039
    "return a string to be shown in the process monitor"
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  3040
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  3041
    ^ self name
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  3042
!
306a2d195c0a *** empty log message ***
claus
parents: 118
diff changeset
  3043
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3044
name
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3045
    "return my name component to be used for resource-access"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3046
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3047
    ^ name
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3048
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3049
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3050
fullName
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3051
    "return my full name to be used for resource-access"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3052
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3053
    superView notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3054
	^ superView fullName , '.' , name
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3055
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3056
    ^ name
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3057
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3058
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3059
widthIncludingBorder
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3060
    "return my width including border"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3061
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3062
    ^ width + (2*borderWidth)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3063
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3064
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3065
name:aString
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3066
    "set my name component to be used for resource-access"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3067
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3068
    name := aString
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3069
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3070
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3071
level
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3072
    "return my level relative to superView (3D)"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3073
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3074
    ^ level
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3075
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3076
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3077
lightColor:aColorOrImage
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3078
    "set the color to be used for lighted edges (3D only)"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3079
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3080
    lightColor := aColorOrImage
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3081
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3082
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3083
shadowColor:aColorOrImage
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3084
    "set the color to be used for shadowed edges (3D only)"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3085
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3086
    shadowColor := aColorOrImage
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3087
! !
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3088
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3089
!View methodsFor:'drawing'!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3090
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3091
drawEdgesForX:x y:y width:w height:h level:l 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3092
		shadow:shadowColor light:lightColor
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3093
		halfShadow:halfShadowColor halfLight:halfLightColor
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3094
		style:edgeStyle
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3095
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3096
    "draw 3D edges into a rectangle"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3097
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3098
    |topLeftFg botRightFg topLeftHalfFg botRightHalfFg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3099
     count "{ Class: SmallInteger }"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3100
     r     "{ Class: SmallInteger }"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3101
     b     "{ Class: SmallInteger }"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3102
     xi    "{ Class: SmallInteger }"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3103
     yi    "{ Class: SmallInteger }"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3104
     run paint|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3105
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3106
    count := l.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3107
    (count < 0) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3108
	topLeftFg := shadowColor.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3109
	botRightFg := lightColor.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3110
	topLeftHalfFg := halfShadowColor.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3111
	botRightHalfFg := halfLightColor.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3112
	count := count negated
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3113
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3114
	topLeftFg := lightColor.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3115
	botRightFg := shadowColor.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3116
	topLeftHalfFg := halfLightColor.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3117
	botRightHalfFg := halfShadowColor.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3118
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3119
    topLeftHalfFg isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3120
	topLeftHalfFg := topLeftFg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3121
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3122
    botRightHalfFg isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3123
	botRightHalfFg := botRightFg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3124
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3125
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3126
    r := x + w - 1. "right"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3127
    b := y + h - 1. "bottom"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3128
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3129
    super lineWidth:0.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3130
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3131
    "top and left edges"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3132
    ((edgeStyle == #soft) and:[l > 0]) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3133
	paint := topLeftHalfFg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3134
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3135
	paint := topLeftFg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3136
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3137
    super paint:paint.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3138
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3139
    0 to:(count - 1) do:[:i |
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3140
	run := y + i.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3141
	super displayDeviceLineFromX:x y:run toX:r y:run. "top"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3142
	run := x + i.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3143
	super displayDeviceLineFromX:run y:y toX:run y:b  "left"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3144
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3145
    (edgeStyle == #soft) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3146
"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3147
	super paint:topLeftFg.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3148
	super displayDeviceLineFromX:x y:y toX:r y:y. 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3149
	super displayDeviceLineFromX:x y:y toX:x y:b        
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3150
"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3151
	(l > 2) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3152
	    super paint:Black.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3153
	    super displayDeviceLineFromX:x y:y toX:r y:y. 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3154
	    super displayDeviceLineFromX:x y:y toX:x y:b. 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3155
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3156
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3157
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3158
    xi := x + 1.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3159
    yi := y + 1.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3160
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3161
"/ does not look good
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3162
"/ style == #st80 iftrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3163
"/  yi := yi + 1
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3164
"/ ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3165
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3166
    "bottom and right edges"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3167
    (edgeStyle == #soft) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3168
	paint := botRightHalfFg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3169
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3170
	paint := botRightFg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3171
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3172
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3173
    super paint:paint.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3174
    0 to:(count - 1) do:[:i |
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3175
	run := b - i.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3176
	super displayDeviceLineFromX:xi-1 y:run toX:r y:run. "bottom"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3177
	run := r - i.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3178
	super displayDeviceLineFromX:run y:yi-1 toX:run y:b.  "right"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3179
	xi := xi + 1.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3180
	yi := yi + 1
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3181
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3182
    ((edgeStyle == #soft) and:[l > 1]) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3183
	super paint:Black "shadowColor".
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3184
	super displayDeviceLineFromX:(x + 1-1) y:b toX:r y:b. 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3185
	super displayDeviceLineFromX:r y:(y + 1 - 1) toX:r y:b        
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3186
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3187
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3188
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3189
redrawX:x y:y width:w height:h
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3190
    "have to redraw part of myself, givel logical coordinates (if trans is nonNil)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3191
     default is to redraw everything - subclasses should add intelligence"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3192
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3193
    |area|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3194
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3195
    area := Rectangle left:x top:y width:w height:h.      
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3196
    self clippedTo:area do:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3197
"/        controller notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3198
"/            "ST-80 updating"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3199
"/            self update:#rectangle with:area
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3200
"/        ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3201
	    components notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3202
		components do:[:aComponent |
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3203
		    |thisFrame is|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3204
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3205
		    thisFrame := aComponent frame.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3206
		    (thisFrame intersects:area) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3207
			is := thisFrame intersect:(x@y extent:w@h).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3208
			is = thisFrame ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3209
			    aComponent redraw
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3210
			] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3211
			    aComponent redrawX:is left
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3212
					     y:is top
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3213
					 width:is width
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3214
					height:is height.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3215
			].        
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3216
			"/ aComponent drawIn:self offset:0@0
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3217
		    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3218
		]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3219
	    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3220
		self redraw
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3221
	    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3222
"/        ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3223
    ]                                                              
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3224
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3225
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3226
drawBottomEdge
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3227
    "draw bottom 3D edge into window frame"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3228
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3229
    self drawBottomEdgeLevel:level
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3230
		      shadow:shadowColor 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3231
		      light:lightColor
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3232
		      halfShadow:nil 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3233
		      halfLight:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3234
		      style:nil.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3235
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3236
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3237
drawEdges
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3238
    "draw all of my 3D edges"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3239
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3240
    self drawEdgesForX:0 y:0 width:width height:height level:level
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3241
		shadow:shadowColor 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3242
		light:lightColor
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3243
		halfShadow:nil 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3244
		halfLight:nil 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3245
		style:nil 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3246
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3247
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3248
redraw
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3249
    "redraw myself
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3250
     if there is a model, this one shall redraw itself,
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3251
     otherwise we cannot do much here - has to be redefined in subclasses"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3252
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3253
    model notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3254
	model update:self
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3255
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3256
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3257
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3258
drawTopEdge
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3259
    "draw top 3D edge into window frame"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3260
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3261
    self drawTopEdgeLevel:level
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3262
		   shadow:shadowColor 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3263
		    light:lightColor
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3264
		    halfShadow:nil 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3265
		    halfLight:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3266
		    style:nil.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3267
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3268
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3269
drawLeftEdge
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3270
    "draw left 3D edge into window frame"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3271
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3272
    self drawLeftEdgeLevel:level
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3273
		    shadow:shadowColor 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3274
		     light:lightColor
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3275
		     halfShadow:nil 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3276
		     halfLight:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3277
		     style:nil.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3278
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3279
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3280
drawRightEdge
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3281
    "draw right 3D edge into window frame"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3282
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3283
    self drawRightEdgeLevel:level
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3284
		     shadow:shadowColor 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3285
		      light:lightColor
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3286
		      halfShadow:nil 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3287
		      halfLight:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3288
		      style:nil.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3289
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3290
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3291
drawRightEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3292
    |rightFg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3293
     count "{ Class: SmallInteger }" 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3294
     r b|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3295
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3296
    count := level.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3297
    count == 0 ifTrue:[^ self].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3298
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3299
    (count < 0) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3300
	rightFg := lightColor.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3301
	count := count negated
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3302
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3303
	((edgeStyle == #soft) and:[level > 1]) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3304
	    rightFg := halfShadowColor
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3305
	] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3306
	    rightFg := shadowColor
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3307
	].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3308
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3309
    super paint:rightFg.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3310
    super lineWidth:0.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3311
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3312
    b := height - 1.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3313
    0 to:(count - 1) do:[:i |
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3314
	r := width - 1 - i.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3315
	super displayDeviceLineFromX:r y:i toX:r y:(b - i)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3316
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3317
    ((edgeStyle == #soft) and:[level > 1]) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3318
	r := width - 1.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3319
	super paint:shadowColor.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3320
	super displayDeviceLineFromX:r y:1 toX:r y:b. 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3321
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3322
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3323
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3324
drawTopEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3325
    |topFg topHalfFg paint r
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3326
     count "{ Class: SmallInteger }" |
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3327
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3328
    count := level.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3329
    count == 0 ifTrue:[^ self].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3330
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3331
    (count < 0) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3332
	topFg := shadowColor.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3333
	topHalfFg := halfShadowColor.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3334
	count := count negated
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3335
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3336
	topFg := lightColor.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3337
	topHalfFg := halfLightColor.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3338
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3339
    topHalfFg isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3340
	topHalfFg := topFg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3341
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3342
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3343
    ((edgeStyle == #soft) and:[level > 0]) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3344
	paint := topHalfFg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3345
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3346
	paint := topFg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3347
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3348
    super paint:paint.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3349
    super lineWidth:0.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3350
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3351
    r := width - 1.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3352
    0 to:(count - 1) do:[:i |
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3353
	super displayDeviceLineFromX:i y:i toX:(r - i) y:i
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3354
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3355
    ((edgeStyle == #soft) and:[level > 2]) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3356
	super paint:Black.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3357
	super displayDeviceLineFromX:0 y:0 toX:r y:0. 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3358
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3359
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3360
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3361
drawBottomEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3362
    |botFg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3363
     count "{ Class: SmallInteger }" 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3364
     b r|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3365
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3366
    count := level.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3367
    count == 0 ifTrue:[^ self].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3368
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3369
    (count < 0) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3370
	botFg := lightColor.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3371
	count := count negated
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3372
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3373
	((edgeStyle == #soft) and:[level > 1]) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3374
	    botFg := halfShadowColor
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3375
	] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3376
	    botFg := shadowColor
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3377
	].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3378
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3379
    super paint:botFg.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3380
    super lineWidth:0.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3381
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3382
    r := width - 1.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3383
    0 to:(count - 1) do:[:i |
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3384
	b := height - 1 - i.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3385
	super displayDeviceLineFromX:i y:b toX:(r - i) y:b
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3386
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3387
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3388
    ((edgeStyle == #soft) and:[level > 1]) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3389
	b := height - 1.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3390
	super paint:shadowColor.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3391
	super displayDeviceLineFromX:1 y:b toX:r y:b. 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3392
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3393
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3394
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3395
drawLeftEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3396
    |leftFg leftHalfFg paint b
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3397
     count "{ Class: SmallInteger }" |
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3398
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3399
    count := level.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3400
    count == 0 ifTrue:[^ self].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3401
    
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3402
    (count < 0) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3403
	leftFg := shadowColor.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3404
	leftHalfFg := halfShadowColor.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3405
	count := count negated.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3406
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3407
	leftFg := lightColor.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3408
	leftHalfFg := halfLightColor.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3409
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3410
    leftHalfFg isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3411
	leftHalfFg := leftFg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3412
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3413
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3414
    ((edgeStyle == #soft) and:[level > 0]) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3415
	paint := leftHalfFg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3416
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3417
	paint := leftFg
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3418
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3419
    super paint:paint.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3420
    super lineWidth:0.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3421
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3422
    b := height - 1.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3423
    0 to:(count - 1) do:[:i |
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3424
	super displayDeviceLineFromX:i y:i toX:i y:(b - i)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3425
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3426
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3427
    ((edgeStyle == #soft) and:[level > 2]) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3428
	super paint:Black.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3429
	super displayDeviceLineFromX:0 y:0 toX:0 y:b. 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3430
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3431
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3432
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3433
drawEdgesForX:x y:y width:w height:h level:l
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3434
    "draw 3D edges into a rectangle"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3435
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3436
    self drawEdgesForX:x y:y width:w height:h level:l 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3437
		shadow:shadowColor 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3438
		light:lightColor
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3439
		halfShadow:nil 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3440
		halfLight:nil 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3441
		style:nil 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3442
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3443
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3444
redrawDeviceX:x y:y width:w height:h
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3445
    "have to redraw part of the view.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3446
     The coordinates are in device space - if there is a transformation,
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3447
     must inverse-transform back to logical coordinates. (since the view thinks
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3448
     in its coordinate space)"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3449
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3450
    |lx ly lw lh|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3451
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3452
    lx := x.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3453
    ly := y.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3454
    lw := w.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3455
    lh := h.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3456
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3457
    transformation notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3458
	lx := transformation applyInverseToX:lx.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3459
	ly := transformation applyInverseToY:ly.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3460
	lw := transformation applyInverseScaleX:lw.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3461
	lh := transformation applyInverseScaleY:lh.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3462
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3463
    self redrawX:lx y:ly width:lw height:lh
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3464
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3465
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3466
redrawEdges
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3467
    "redraw my edges (if any)"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3468
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3469
    (level ~~ 0) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3470
	self clipRect:nil.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3471
	self drawEdges.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3472
	self clipRect:innerClipRect
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3473
    ]                  
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3474
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3475
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3476
showFocus
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3477
    "highlight myself somehow to tell user that I have the focus"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3478
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3479
    |delta|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3480
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3481
    drawableId notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3482
	delta := DefaultFocusBorderWidth - borderWidth.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3483
	delta ~~ 0 ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3484
	    device moveWindow:drawableId x:left-delta y:top-delta
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3485
	].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3486
	device setWindowBorderWidth:DefaultFocusBorderWidth in:drawableId.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3487
	device setWindowBorderColor:(DefaultFocusColor on:device) colorId in:drawableId.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3488
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3489
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3490
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3491
showNoFocus
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3492
    "undo the effect of showFocus"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3493
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3494
    |delta|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3495
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3496
    drawableId notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3497
	delta := DefaultFocusBorderWidth - borderWidth.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3498
	delta ~~ 0 ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3499
	    device moveWindow:drawableId x:left+delta y:top+delta
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3500
	].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3501
	device setWindowBorderWidth:borderWidth in:drawableId.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3502
	self setBorderColor.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3503
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3504
! !
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3505
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3506
!View methodsFor:'realization'!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3507
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3508
initializeMiddleButtonMenu
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3509
    "a place to initialize menu - this one is sent once when the view is
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3510
     first created; usually redefined in subclasses; default here is no menu"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3511
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3512
    ^ self
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3513
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3514
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3515
fixSize
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3516
    "This is called right before the view is made visible.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3517
     Adjust the size of the view according to either relative/abs or
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3518
     block extent; also set origin. Also, subclasses may redefine this
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3519
     method to adjust the size based on some extent (for example, PopUpMenus
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3520
     do so to take care of changed number of menu entries)."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3521
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3522
    |org|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3523
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3524
    window notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3525
	^ self superViewChangedSize
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3526
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3527
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3528
    "if the extent is not the one we created the window with ..."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3529
    extentChanged ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3530
	self sizeChanged:nil.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3531
	extentChanged := false
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3532
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3533
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3534
    originChanged ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3535
"/        org := self computeOrigin.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3536
"/        self pixelOrigin:org.    
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3537
	originRule notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3538
	    self pixelOrigin:(originRule value)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3539
	] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3540
	    relativeOrigin notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3541
		self originFromRelativeOrigin
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3542
	    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3543
		device moveWindow:drawableId x:left y:top.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3544
	    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3545
	].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3546
	originChanged := false
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3547
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3548
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3549
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3550
realizeLeavingGroup:leaveGroupAsIs 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3551
    "common helper for realize and realizeInGroup"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3552
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3553
    |superGroup groupChange|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3554
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3555
    drawableId isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3556
	self create.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3557
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3558
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3559
    leaveGroupAsIs ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3560
	"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3561
	 put myself into superviews windowgroup if there is a superview
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3562
	"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3563
	groupChange := false.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3564
	superView notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3565
	    superGroup := superView windowGroup.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3566
	    (windowGroup notNil and:[superGroup ~~ windowGroup]) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3567
		"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3568
		 mhmh - seems that the windowgroup has changed ....
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3569
		"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3570
"/                'oops - wgroup change on realize' printNewline.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3571
		windowGroup removeView:self.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3572
		windowGroup := nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3573
	    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3574
	    superGroup ~~ windowGroup ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3575
		groupChange := true.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3576
		windowGroup := superGroup.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3577
		windowGroup notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3578
		    windowGroup addView:self.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3579
		]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3580
	    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3581
	].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3582
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3583
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3584
    hidden ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3585
	(originChanged or:[extentChanged]) ifTrue:[self fixSize].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3586
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3587
	(realized not or:[groupChange]) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3588
	    subViews notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3589
		subViews do:[:subView |
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3590
		    subView realize
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3591
		]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3592
	    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3593
	].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3594
	self setInnerClip.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3595
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3596
	realized ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3597
	    "
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3598
	     now, make the view visible
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3599
	    "
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3600
	    device mapWindow:drawableId.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3601
	    realized := true
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3602
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3603
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3604
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3605
    controller notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3606
	controller startUp
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3607
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3608
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3609
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3610
physicalCreate
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3611
    "common code for create & recreate"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3612
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3613
    "associate colors to device"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3614
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3615
    drawableId := device 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3616
		      createWindowFor:self 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3617
			  origin:(left @ top)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3618
			  extent:(width @ height)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3619
			  minExtent:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3620
			  maxExtent:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3621
			  borderWidth:borderWidth
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3622
			  subViewOf:superView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3623
			  onTop:(self createOnTop)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3624
			  inputOnly:(self inputOnly)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3625
			  label:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3626
			  cursor:cursor
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3627
			  icon:nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3628
			  iconView:nil.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3629
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3630
    Lobby changed:self.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3631
    extentChanged := false.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3632
    originChanged := false.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3633
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3634
    (borderColor notNil and:[borderColor ~~ Black]) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3635
"/        borderColor := borderColor on:device.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3636
	self setBorderColor
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3637
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3638
    (viewGravity notNil "and:[viewGravity ~~ #NorthWest]") ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3639
	device setWindowGravity:viewGravity in:drawableId
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3640
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3641
    (bitGravity notNil "and:[bitGravity ~~ #NorthWest]") ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3642
	device setBitGravity:bitGravity in:drawableId
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3643
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3644
    borderShape notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3645
	device setWindowBorderShape:(borderShape id) in:drawableId
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3646
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3647
    viewShape notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3648
	device setWindowShape:(viewShape id) in:drawableId
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3649
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3650
    (backed notNil and:[backed ~~ false]) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3651
	device setBackingStore:backed in:drawableId
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3652
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3653
    saveUnder ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3654
	device setSaveUnder:true in:drawableId
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3655
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3656
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3657
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3658
unrealize
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3659
    "hide me"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3660
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3661
    realized ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3662
	drawableId notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3663
	    device unmapWindow:drawableId
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3664
	].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3665
	realized := shown := false.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3666
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3667
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3668
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3669
realize
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3670
    "realize - make visible;
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3671
     realizing is done very late (after layout is fixed) to avoid
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3672
     visible rearranging of windows on the screen"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3673
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3674
    self realizeLeavingGroup:false
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3675
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3676
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3677
create
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3678
    "create (i.e. tell X about me)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3679
     this is kind of stupid - creation means XCreateWindow;
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3680
     realizing means XMapWindow"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3681
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3682
    drawableId isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3683
	"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3684
	 make certain that superview is created also
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3685
	"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3686
	superView notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3687
"/            superView id isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3688
		superView create.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3689
"/            ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3690
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3691
"/            "and put my controller into the superviews controller list"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3692
"/            controller notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3693
"/                superView controller notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3694
"/                    controller manager:(superView controller manager)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3695
"/                ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3696
"/            ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3697
	].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3698
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3699
	cursor := cursor on:device.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3700
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3701
	self physicalCreate.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3702
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3703
	viewBackground notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3704
	   self setViewBackground
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3705
	].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3706
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3707
	self initializeMiddleButtonMenu.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3708
	self initEvents.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3709
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3710
	"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3711
	 this is the first create,
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3712
	 force sizechange messages to be sent to the view
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3713
	"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3714
	extentChanged := true.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3715
	originChanged := true
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3716
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3717
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3718
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3719
open
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3720
    "open up the view - for normal views, this is a modeless open
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3721
     (i.e. the new view comes up as independent process).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3722
     This is redefined in ModalBox, which comes up modal (i.e. 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3723
     control is under the current process, so that interaction with the
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3724
     current group is blocked while the modalBox is active)."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3725
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3726
    ^ self openModeless
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3727
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3728
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3729
openModeless
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3730
    "create and schedule a new windowgroup for me and open the view.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3731
     The view will be handled by its own process, effectively running in
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3732
     parallel."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3733
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3734
    ProcessorScheduler isPureEventDriven ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3735
	windowGroup isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3736
	    windowGroup := WindowGroup new.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3737
	    windowGroup addTopView:self.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3738
	].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3739
	windowGroup startup.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3740
    ] ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3741
	self realize
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3742
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3743
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3744
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3745
openModal
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3746
    "create a new windowgroup, but start processing in the current process
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3747
     actually suspending event processing for the currently active group.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3748
     Stay in modalLoop while view is visible."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3749
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3750
    self openModal:[true]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3751
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3752
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3753
recreate
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3754
    "recreate (i.e. tell X about me) after a snapin"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3755
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3756
    drawableId isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3757
	super recreate.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3758
	self physicalCreate.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3759
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3760
	viewBackground notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3761
	    self setViewBackground 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3762
	].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3763
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3764
	"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3765
	 XXX has to be changed: eventmasks are device specific -
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3766
	 XXX will not allow restart on another Workstation-type.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3767
	 XXX event masks must become symbolic
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3768
	"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3769
	device setEventMask:eventMask in:drawableId
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3770
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3771
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3772
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3773
createWithAllSubViews
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3774
    "create, then create all subviews"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3775
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3776
    drawableId isNil ifTrue:[self create].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3777
    subViews notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3778
	subViews do:[:subView | subView createWithAllSubViews]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3779
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3780
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3781
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3782
destroy
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3783
    "unrealize & destroy - make me invisible, destroy subviews then
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3784
     make me unknown to the device"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3785
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3786
    |subs|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3787
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3788
    realized ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3789
	self unrealize.            
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3790
	"make it go away immediately
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3791
	 - also, this hides the subview killing"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3792
"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3793
	device synchronizeOutput. 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3794
"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3795
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3796
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3797
    model notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3798
	model removeDependent:self.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3799
	model := nil.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3800
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3801
    controller notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3802
	controller release.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3803
	controller := nil.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3804
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3805
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3806
    subs := subViews.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3807
    subs notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3808
	"stupid: destroy removes itself from the subview list
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3809
	 - therefore we have to loop over a copy here"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3810
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3811
	subViews := nil.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3812
	subs do:[:aView |
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3813
	    aView notNil ifTrue:[aView destroy]             
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3814
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3815
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3816
    superView notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3817
	superView removeSubView:self.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3818
	superView := nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3819
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3820
    super destroy.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3821
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3822
    windowGroup notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3823
	windowGroup removeView:self.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3824
	windowGroup := nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3825
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3826
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3827
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3828
realizeInGroup
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3829
    "special realize - leave windowgroup as is; 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3830
     This allows a view to be realized in any windowgroup; 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3831
     for special applications, like the kill button in the Filebrowser which has
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3832
     another windowGroup as its superview and is handled as a separate process."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3833
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3834
    self realizeLeavingGroup:true
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3835
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3836
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3837
openModal:aBlock
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3838
    "create a new windowgroup, but start processing in the current process -
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3839
     actually suspending event processing for the currently active group.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3840
     Stay in this modal loop while aBlock evaluates to true AND the receiver is
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3841
     visible.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3842
     This makes any interaction with the current window impossible - 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3843
     however, other views (in other windowgroups) still work."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3844
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3845
    |activeGroup tops|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3846
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3847
    Processor activeProcessIsSystemProcess ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3848
	self realize
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3849
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3850
	activeGroup := WindowGroup activeGroup.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3851
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3852
	"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3853
	 create a new window group and put myself into it
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3854
	"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3855
	windowGroup := WindowGroup new.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3856
	windowGroup addTopView:self.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3857
	"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3858
	 go dispatch events in this new group
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3859
	 (thus current windowgroup is blocked from interaction)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3860
	"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3861
	Object abortSignal handle:[:ex |
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3862
	    self hide.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3863
	    ex return.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3864
	] do:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3865
	    [
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3866
		windowGroup startupModal:[realized and:aBlock]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3867
	    ] valueOnUnwindDo:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3868
		self hide.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3869
	    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3870
	].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3871
	"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3872
	 return input focus to previously active groups top.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3873
	 This helps with windowmanagers which need an explicit click
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3874
	 on the view for the focus.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3875
	"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3876
	activeGroup notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3877
	    tops := activeGroup topViews.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3878
	    (tops notNil and:[tops notEmpty]) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3879
		tops first getKeyboardFocus
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3880
	    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3881
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3882
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3883
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3884
123
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
  3885
rerealizeWithAllSubViews
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
  3886
    "rerealize myself with all subviews"
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3887
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3888
    drawableId notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3889
	realized := true.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3890
	subViews notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3891
	    subViews do:[:aView |
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3892
		aView realize
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3893
	    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3894
	].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3895
	device mapView:self id:drawableId iconified:false
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3896
		   atX:left y:top width:width height:height
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3897
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3898
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3899
123
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
  3900
rerealize
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
  3901
    "rerealize at old position"
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
  3902
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
  3903
    drawableId notNil ifTrue:[
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
  3904
	realized := true.
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
  3905
	device mapView:self id:drawableId iconified:false
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
  3906
		   atX:left y:top width:width height:height
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
  3907
    ]
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
  3908
!
9f8c7f20fdb2 *** empty log message ***
claus
parents: 121
diff changeset
  3909
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3910
openAutonomous
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3911
    "create and schedule a new windowgroup for me and open the view.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3912
     The view will be handled by its own process, effectively running in
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3913
     parallel. This entry is for non-topviews, which want to be served
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3914
     autonomous from the topview. (see the fileBrowsers kill-button
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3915
     when executing unix commands as an example)"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3916
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3917
    |wg|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3918
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3919
    ProcessorScheduler isPureEventDriven ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3920
	wg := WindowGroup new.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3921
	self windowGroup:wg.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3922
	wg addView:self.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3923
	wg startup.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3924
	self realizeInGroup.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3925
    ] ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3926
	self realize
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3927
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3928
! !
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3929
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3930
!View methodsFor:'adding & removing components'!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3931
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3932
setParentViewIn:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3933
    "common code for addSubView* methods"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3934
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3935
    aView superView:self.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3936
    (aView device ~~ device) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3937
	'warning subview (' errorPrint. aView class name errorPrint.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3938
	') has different device than me (' errorPrint.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3939
	self class name errorPrint. ').' errorPrintNewline.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3940
	aView device:device
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3941
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3942
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3943
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3944
addSubView:newView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3945
    "add a view to the collection of subviews"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3946
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3947
    subViews isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3948
	subViews := OrderedCollection with:newView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3949
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3950
	subViews add:newView.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3951
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3952
    self setParentViewIn:newView.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3953
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3954
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3955
removeSubView:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3956
    "remove a view from the collection of subviews"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3957
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3958
    subViews notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3959
	subViews remove:aView ifAbsent:[nil].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3960
	(subViews size == 0) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3961
	    subViews := nil
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3962
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3963
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3964
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3965
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3966
addComponent:aComponent
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3967
    "components (i.e. gadgets or lightweight views) are being prepared. 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3968
     Dont use this right now"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3969
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3970
    components isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3971
	components := OrderedCollection new
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3972
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3973
    components add:aComponent.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3974
    aComponent setParentViewIn:self
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3975
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3976
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3977
component:aComponent
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3978
    "components (i.e. gadgets or lightweight views) are being prepared. 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3979
     Dont use this right now"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3980
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3981
    components := OrderedCollection with:aComponent.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3982
    aComponent setParentViewIn:self
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3983
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3984
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3985
removeComponent:aComponent
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3986
    "components (i.e. gadgets or lightweight views) are being prepared. 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3987
     Dont use this right now"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3988
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3989
    components isNil ifTrue:[^self].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3990
    components remove:aComponent ifAbsent:[].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3991
    aComponent parent:nil 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3992
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3993
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3994
addSubView:newView after:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3995
    "add a view to the collection of subviews after another view.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3996
     This makes sense, in Panels and other layout views, to enter a new
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3997
     element at some defined place."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3998
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  3999
    subViews isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4000
	subViews := OrderedCollection with:newView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4001
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4002
	subViews add:newView after:aView.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4003
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4004
    self setParentViewIn:newView.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4005
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4006
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4007
addSubView:newView before:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4008
    "add a view to the collection of subviews before another view.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4009
     This makes sense, in Panels and other layout views, to enter a new
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4010
     element at some defined place."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4011
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4012
    subViews isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4013
	subViews := OrderedCollection with:newView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4014
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4015
	subViews add:newView before:aView.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4016
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4017
    self setParentViewIn:newView.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4018
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4019
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4020
addSubView:aView in:bounds borderWidth:bw
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4021
    "for ST-80 compatibility"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4022
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4023
    aView borderWidth:bw.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4024
    aView origin:(bounds origin x asFloat) @ (bounds origin y asFloat)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4025
	  extent:(bounds extent x asFloat) @ (bounds extent y asFloat).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4026
    self addSubView:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4027
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4028
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4029
add:aView in:bounds
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4030
    "for ST-80 compatibility"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4031
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4032
    aView origin:(bounds origin x asFloat) @ (bounds origin y asFloat)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4033
	  extent:(bounds extent x asFloat) @ (bounds extent y asFloat).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4034
    self addSubView:aView
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4035
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4036
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4037
addSubView:aView viewport:aRectangle
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4038
    "Adds aView to the views list of subviews and uses the
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4039
     existing subviews window and the new viewport to position it"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4040
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4041
    self addSubView:aView.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4042
    aView viewport:aRectangle
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4043
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4044
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4045
addSubView:aView window:aWindowRectangle viewport:aViewportRectangle
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4046
    "Adds aView to the views list of subviews and uses 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4047
     aWindowRectangle and aViewportRectangle to position it"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4048
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4049
    self addSubView:aView.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4050
    aView window:aWindowRectangle.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4051
    aView viewport:aViewportRectangle
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4052
! !
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4053
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4054
!View methodsFor:'queries'!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4055
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4056
canHandle:aKey
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4057
    "return true, if I like to handle the key (keyPress event)"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4058
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4059
    ^ true
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4060
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4061
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4062
buttonMotionEventPending
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4063
    "return true, if a button motion event is pending.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4064
     Normally, you dont want to use this, since no polling is needed
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4065
     (not even for mouse-tracking).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4066
     Dont use it, since it does not honor the windowGroup, but
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4067
     goes directly to the device instead.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4068
     Actually, its a historical leftover"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4069
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4070
    windowGroup notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4071
	^ windowGroup sensor hasButtonMotionEventsFor:self
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4072
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4073
    ^ super buttonMotionEventPending
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4074
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4075
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4076
preferedExtent
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4077
    "return my preferred extent - this is the minimum size I would like to have.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4078
     The default here is the actual extent, the receiver currently has."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4079
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4080
    ^ self extent
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4081
! !
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4082
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4083
!View methodsFor:'enumerating subviews'!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4084
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4085
allSubViewsDo:aBlock
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4086
    "evaluate aBlock for all subviews (recursively)"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4087
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4088
    (subViews isNil or:[subViews isEmpty]) ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4089
	subViews do:[:aSubview |
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4090
	    aSubview withAllSubViewsDo:aBlock
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4091
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4092
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4093
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4094
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4095
withAllSubViewsDo:aBlock
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4096
    "evaluate aBlock for the receiver and all subviews (recursively)"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4097
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4098
    aBlock value:self.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4099
    self allSubViewsDo:aBlock
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4100
! !
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4101
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4102
!View methodsFor:'scrolling-basic'!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4103
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4104
scrollUp:nPixels
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4105
    "change origin to scroll up (towards the origin) by some pixels"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4106
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4107
    |count "{ Class:SmallInteger }"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4108
     m2    "{ Class:SmallInteger }"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4109
     w     "{ Class:SmallInteger }"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4110
     h     "{ Class:SmallInteger }"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4111
     orgX
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4112
     orgY  "{ Class:SmallInteger }"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4113
     newOrigin|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4114
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4115
    transformation isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4116
	orgY := orgX := 0
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4117
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4118
	orgY := transformation translation y negated.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4119
	orgX := transformation translation x negated
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4120
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4121
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4122
    count := nPixels.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4123
    (count > orgY) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4124
	count := orgY
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4125
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4126
    (count <= 0) ifTrue:[^ self].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4127
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4128
    self originWillChange.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4129
    newOrigin := orgX @ (orgY - count).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4130
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4131
    shown ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4132
	self setViewOrigin:newOrigin.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4133
    ] ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4134
	m2 := margin * 2. "top & bottom margins"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4135
	(count >= self innerHeight) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4136
	    self setViewOrigin:newOrigin.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4137
	    self redrawDeviceX:margin y:margin
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4138
			 width:(width - m2)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4139
			height:(height - m2).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4140
	] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4141
	    h := height - m2 - count.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4142
	    w := width.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4143
	    self catchExpose.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4144
	    self setViewOrigin:newOrigin.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4145
	    self copyFrom:self x:margin y:margin
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4146
			     toX:margin y:(count + margin)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4147
			   width:w height:h.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4148
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4149
	    self setInnerClip.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4150
	    self redrawDeviceX:margin y:margin
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4151
			 width:(width - m2)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4152
			height:count.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4153
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4154
	    self waitForExpose.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4155
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4156
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4157
    self originChanged:(0 @ count negated).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4158
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4159
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4160
scrollDown:nPixels
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4161
    "change origin to scroll down some pixels"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4162
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4163
    |count "{ Class:SmallInteger }"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4164
     m2    "{ Class:SmallInteger }"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4165
     w     "{ Class:SmallInteger }"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4166
     h     "{ Class:SmallInteger }"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4167
     hCont 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4168
     ih    "{ Class:SmallInteger }"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4169
     orgX  
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4170
     orgY  "{ Class:SmallInteger }"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4171
     newOrigin|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4172
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4173
    hCont := self heightOfContents.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4174
    transformation isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4175
	orgY := orgX := 0
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4176
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4177
	hCont := (transformation applyScaleY:hCont) rounded.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4178
	orgY := transformation translation y negated.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4179
	orgX := transformation translation x negated.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4180
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4181
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4182
    count := nPixels.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4183
    ih := self innerHeight.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4184
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4185
    ((orgY + nPixels + ih) > hCont) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4186
	count := hCont - orgY - ih
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4187
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4188
    (count <= 0) ifTrue:[^ self].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4189
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4190
    self originWillChange.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4191
    newOrigin := orgX @ (orgY + count).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4192
    shown ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4193
	self setViewOrigin:newOrigin.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4194
    ] ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4195
	m2 := margin * 2.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4196
	(count >= ih) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4197
	    self setViewOrigin:newOrigin.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4198
	    self redrawDeviceX:margin y:margin
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4199
			 width:(width - m2)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4200
			height:(height - m2).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4201
	] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4202
	    h := height - m2 - count.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4203
	    w := self width.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4204
	    self catchExpose.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4205
	    self setViewOrigin:newOrigin.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4206
	    self copyFrom:self x:margin y:(count + margin)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4207
			     toX:margin y:margin
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4208
			   width:w 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4209
			  height:h.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4210
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4211
	    self setInnerClip.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4212
	    self redrawDeviceX:margin y:(h + margin) 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4213
			 width:(width - m2) height:count.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4214
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4215
	    self waitForExpose.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4216
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4217
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4218
    self originChanged:(0 @ count).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4219
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4220
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4221
scrollLeft:nPixels
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4222
    "change origin to scroll left some pixels"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4223
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4224
    |count "{ Class:SmallInteger }"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4225
     m2    "{ Class:SmallInteger }"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4226
     h     "{ Class:SmallInteger }"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4227
     orgX orgY newOrigin|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4228
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4229
    transformation isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4230
	orgY := orgX := 0
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4231
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4232
	orgY := transformation translation y negated.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4233
	orgX := transformation translation x negated.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4234
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4235
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4236
    count := nPixels.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4237
    (count > orgX) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4238
	count := orgX
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4239
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4240
    (count <= 0) ifTrue:[^ self].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4241
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4242
    self originWillChange.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4243
    newOrigin := (orgX - count) @ orgY.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4244
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4245
    shown ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4246
	self setViewOrigin:newOrigin.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4247
    ] ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4248
	m2 := margin * 2.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4249
	(count >= self innerWidth) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4250
	    self setViewOrigin:newOrigin.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4251
	    self redrawDeviceX:margin y:margin
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4252
			 width:(width - m2)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4253
			height:(height - m2).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4254
	] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4255
	    h := (height - m2).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4256
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4257
	    self catchExpose.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4258
	    self setViewOrigin:newOrigin.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4259
	    self copyFrom:self x:margin y:margin
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4260
			     toX:(count + margin) y:margin
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4261
			   width:(width - m2 - count) 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4262
			  height:h.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4263
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4264
	    self setInnerClip.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4265
	    self redrawDeviceX:margin y:margin
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4266
			 width:count height:(height - m2).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4267
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4268
	    self waitForExpose.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4269
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4270
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4271
    self originChanged:(count negated @ 0).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4272
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4273
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4274
scrollRight:nPixels
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4275
    "change origin to scroll right some pixels"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4276
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4277
    |count "{ Class:SmallInteger }"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4278
     m2    "{ Class:SmallInteger }"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4279
     h     "{ Class:SmallInteger }" 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4280
     wCont 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4281
     iw    "{ Class:SmallInteger }"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4282
     orgX orgY newOrigin|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4283
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4284
    wCont := self widthOfContents.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4285
    transformation isNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4286
	orgY := orgX := 0
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4287
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4288
	wCont := (transformation applyScaleX:wCont) rounded.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4289
	orgY := transformation translation y negated.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4290
	orgX := transformation translation x negated.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4291
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4292
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4293
    count := nPixels.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4294
    iw := self innerWidth.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4295
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4296
    ((orgX + nPixels + iw) > wCont) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4297
	count := wCont - orgX - iw
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4298
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4299
    (count <= 0) ifTrue:[^ self].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4300
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4301
    self originWillChange.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4302
    newOrigin := (orgX + count) @ orgY.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4303
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4304
    shown ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4305
	self setViewOrigin:newOrigin.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4306
    ] ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4307
	m2 := margin * 2.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4308
	(count >= iw) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4309
	    self setViewOrigin:newOrigin.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4310
	    self redrawDeviceX:margin y:margin
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4311
			 width:(width - m2)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4312
			height:(height - m2).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4313
	] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4314
	    m2 := margin * 2.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4315
	    h := (height - m2).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4316
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4317
	    self catchExpose.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4318
	    self setViewOrigin:newOrigin.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4319
	    self copyFrom:self x:(count + margin) y:margin
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4320
			     toX:margin y:margin
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4321
			   width:(width - m2 - count) 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4322
			  height:h.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4323
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4324
	    self setInnerClip.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4325
	    self redrawDeviceX:(width - margin - count) y:margin 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4326
			 width:count height:(height - m2).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4327
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4328
	    self waitForExpose.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4329
	].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4330
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4331
    self originChanged:(count @ 0).
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4332
! !
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4333
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4334
!View methodsFor:'scrolling'!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4335
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4336
widthForScrollBetween:yStart and:yEnd 
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4337
    "return the width in pixels for a scroll between yStart and yEnd
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4338
     - return full width here since we do not know how wide contents is.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4339
     Views which only use part of their space (short lists, text) may redefine
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4340
     this method and return the number of pixels that have to be scrolled.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4341
     On slow displays, this may make a difference; on fast ones you will probably
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4342
     not notice any difference."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4343
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4344
    ^ (width - margin - margin)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4345
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4346
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4347
verticalScrollStep
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4348
    "return the amount to scroll when stepping up/down.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4349
     Subclasses may want to redefine this."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4350
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4351
    ^ (device verticalPixelPerMillimeter * 20) asInteger
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4352
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4353
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4354
scrollVerticalToPercent:percent
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4355
    "scroll to a position given in percent of total"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4356
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4357
    |hCont|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4358
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4359
    hCont := self heightOfContents.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4360
    transformation notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4361
	hCont := transformation applyScaleY:hCont.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4362
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4363
    self scrollVerticalTo:
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4364
	    ((((hCont * percent) / 100.0) + 0.5) asInteger)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4365
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4366
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4367
scrollVerticalTo:aPixelOffset
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4368
    "change origin to make aPixelOffset be the top line"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4369
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4370
    |orgY|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4371
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4372
    orgY := self viewOrigin y.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4373
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4374
    (aPixelOffset < orgY) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4375
	self scrollUp:(orgY - aPixelOffset)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4376
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4377
	(aPixelOffset > orgY) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4378
	    self scrollDown:(aPixelOffset - orgY)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4379
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4380
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4381
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4382
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4383
horizontalScrollStep
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4384
    "return the amount to scroll when stepping left/right.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4385
     Subclasses may want to redefine this."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4386
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4387
    ^ (device horizontalPixelPerMillimeter * 20) asInteger
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4388
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4389
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4390
scrollHorizontalToPercent:percent
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4391
    "scroll to a position given in percent of total"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4392
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4393
    |wCont|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4394
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4395
    wCont := self widthOfContents.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4396
    transformation notNil ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4397
	wCont := transformation applyScaleX:wCont.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4398
    ].
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4399
    self scrollHorizontalTo:
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4400
	    ((((wCont * percent) / 100.0) + 0.5) asInteger)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4401
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4402
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4403
scrollHorizontalTo:aPixelOffset
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4404
    "change origin to make aPixelOffset be the left col"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4405
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4406
    |orgX|
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4407
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4408
    orgX := self viewOrigin x.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4409
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4410
    (aPixelOffset < orgX) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4411
	self scrollLeft:(orgX - aPixelOffset)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4412
    ] ifFalse:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4413
	(aPixelOffset > orgX) ifTrue:[
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4414
	    self scrollRight:(aPixelOffset - orgX)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4415
	]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4416
    ]
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4417
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4418
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4419
scrollTo:aPixelOffset
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4420
    "only here for historic reasons - will vanish soon"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4421
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4422
    ^ self scrollVerticalTo:aPixelOffset
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4423
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4424
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4425
scrollToTop
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4426
    "move viewOrigin to top"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4427
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4428
    self scrollVerticalTo:0
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4429
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4430
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4431
scrollToTopLeft
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4432
    "move viewOrigin to top/left"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4433
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4434
    self scrollVerticalTo:0.
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4435
    self scrollHorizontalTo:0
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4436
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4437
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4438
scrollUp
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4439
    "scroll up by some amount; this is called when the scrollbars
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4440
     scroll-step up button is pressed."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4441
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4442
    self scrollUp:(self verticalScrollStep)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4443
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4444
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4445
scrollDown
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4446
    "scroll down by some amount; this is called when the scrollbars
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4447
     scroll-step down button is pressed."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4448
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4449
    self scrollDown:(self verticalScrollStep)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4450
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4451
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4452
scrollLeft
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4453
    "scroll left by some amount; this is called when the scrollbars
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4454
     scroll-step left button is pressed."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4455
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4456
    self scrollLeft:(self horizontalScrollStep)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4457
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4458
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4459
scrollRight
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4460
    "scroll right by some amount; this is called when the scrollbars
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4461
     scroll-step right button is pressed."
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4462
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4463
    self scrollRight:(self horizontalScrollStep)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4464
! !
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4465
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4466
!View methodsFor:'user notification'!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4467
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4468
warn:aString
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4469
    "like Objects warn, but translates the string via the
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4470
     resourcePack, thus giving a translated string automatically"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4471
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4472
    super warn:(resources string:aString)
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4473
!
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4474
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4475
warn:aString with:argument
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4476
    "like Objects warn, but translates the string via the
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4477
     resourcePack, thus giving a translated string automatically"
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4478
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4479
    super warn:(resources string:aString with:argument)
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  4480
! !
36
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  4481
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  4482
!View methodsFor:'cursor animation'!
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  4483
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  4484
showBusyWhile:aBlock
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  4485
    "evaluate some time consuming block, while doing this,
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  4486
     show a spinning wheel cursor"
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  4487
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  4488
    |ok bitmaps cursors mask process oldCursor|
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  4489
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  4490
    oldCursor := cursor.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  4491
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  4492
    ok := true.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  4493
    bitmaps := #('wheel1' 'wheel2' 'wheel3' 'wheel4') 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  4494
	       collect:[:name |
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  4495
		   |f|
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  4496
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  4497
		   f := Form fromFile:(name , '.xbm').
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  4498
		   f isNil ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  4499
			('no bitmap file: ' , name , '.xbm') errorPrintNL.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  4500
			ok := false
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  4501
		   ].
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  4502
		   f
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  4503
	       ].
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  4504
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  4505
    mask := Form fromFile:'wheelm.xbm'.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  4506
    mask isNil ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  4507
	('no bitmap file: ' , mask , '.xbm') errorPrintNL.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  4508
	ok := false
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  4509
    ].
36
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  4510
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  4511
    ok ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  4512
	self cursor:Cursor wait.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  4513
	aBlock valueNowOrOnUnwindDo:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  4514
	    self cursor:oldCursor
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  4515
	]
36
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  4516
    ] ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  4517
	cursors := bitmaps collect:[:form | (Cursor sourceForm:form
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  4518
						      maskForm:mask
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  4519
							  hotX:8
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  4520
							  hotY:8) on:device].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  4521
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  4522
	process := [
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  4523
		    (Delay forSeconds:0.25) wait.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  4524
		    [true] whileTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  4525
			cursors do:[:curs |
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  4526
			    self cursor:curs.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  4527
			    (Delay forSeconds:0.05) wait
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  4528
			]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  4529
		    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  4530
		   ] fork.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  4531
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  4532
	Processor activeProcess priority:7.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  4533
	aBlock valueNowOrOnUnwindDo:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  4534
	    Processor activeProcess priority:8.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  4535
	    process terminate.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  4536
	    self cursor:oldCursor
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  4537
	]
36
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  4538
    ].
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  4539
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  4540
    "
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  4541
     View new realize showBusyWhile:[10 timesRepeat:[3000 factorial]]
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  4542
    "
36
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  4543
! !
118
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4544
25e775072a89 *** empty log message ***
claus
parents: 116
diff changeset
  4545
View initialize!