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