View.st
author claus
Fri, 16 Jul 1993 11:42:20 +0200
changeset 0 48194c26a46c
child 2 b35336ab0de3
permissions -rw-r--r--
Initial revision
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
0
48194c26a46c Initial revision
claus
parents:
diff changeset
     1
"
48194c26a46c Initial revision
claus
parents:
diff changeset
     2
 COPYRIGHT (c) 1989-93 by Claus Gittinger
48194c26a46c Initial revision
claus
parents:
diff changeset
     3
              All Rights Reserved
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
48194c26a46c Initial revision
claus
parents:
diff changeset
    15
                              components style resources
48194c26a46c Initial revision
claus
parents:
diff changeset
    16
                              transformation viewport
48194c26a46c Initial revision
claus
parents:
diff changeset
    17
                              borderColor borderWidth borderShape viewShape
48194c26a46c Initial revision
claus
parents:
diff changeset
    18
                              top left
48194c26a46c Initial revision
claus
parents:
diff changeset
    19
                              extentChanged originChanged cornerChanged
48194c26a46c Initial revision
claus
parents:
diff changeset
    20
                              relativeOrigin relativeExtent relativeCorner
48194c26a46c Initial revision
claus
parents:
diff changeset
    21
                              originRule extentRule cornerRule
48194c26a46c Initial revision
claus
parents:
diff changeset
    22
                              topInset leftInset bottomInset rightInset
48194c26a46c Initial revision
claus
parents:
diff changeset
    23
                              shown hidden name
48194c26a46c Initial revision
claus
parents:
diff changeset
    24
                              level softEdge margin innerClipRect
48194c26a46c Initial revision
claus
parents:
diff changeset
    25
                              shadowColor lightColor
48194c26a46c Initial revision
claus
parents:
diff changeset
    26
                              halfShadowColor halfLightColor
48194c26a46c Initial revision
claus
parents:
diff changeset
    27
                              viewOrigin 
48194c26a46c Initial revision
claus
parents:
diff changeset
    28
                              contentsChangeAction originChangeAction
48194c26a46c Initial revision
claus
parents:
diff changeset
    29
                              bitGravity viewGravity
48194c26a46c Initial revision
claus
parents:
diff changeset
    30
                              keyboardHandler model controller
48194c26a46c Initial revision
claus
parents:
diff changeset
    31
                              aspectSymbol changeSymbol menuSymbol'
48194c26a46c Initial revision
claus
parents:
diff changeset
    32
       classVariableNames:   'Grey ZeroPoint CentPoint
48194c26a46c Initial revision
claus
parents:
diff changeset
    33
                              ViewSpacing DefaultStyle
48194c26a46c Initial revision
claus
parents:
diff changeset
    34
			      Resources'
48194c26a46c Initial revision
claus
parents:
diff changeset
    35
       poolDictionaries:     ''
48194c26a46c Initial revision
claus
parents:
diff changeset
    36
       category:'Views-Basic'
48194c26a46c Initial revision
claus
parents:
diff changeset
    37
!
48194c26a46c Initial revision
claus
parents:
diff changeset
    38
48194c26a46c Initial revision
claus
parents:
diff changeset
    39
View comment:'
48194c26a46c Initial revision
claus
parents:
diff changeset
    40
48194c26a46c Initial revision
claus
parents:
diff changeset
    41
COPYRIGHT (c) 1989-93 by Claus Gittinger
48194c26a46c Initial revision
claus
parents:
diff changeset
    42
              All Rights Reserved
48194c26a46c Initial revision
claus
parents:
diff changeset
    43
48194c26a46c Initial revision
claus
parents:
diff changeset
    44
this class implements functions common to all Views. Instances of View are seldom
48194c26a46c Initial revision
claus
parents:
diff changeset
    45
used, most views in the system inherit from this class. However, sometimes a view 
48194c26a46c Initial revision
claus
parents:
diff changeset
    46
is used to create a dummy view for framing purposes.
48194c26a46c Initial revision
claus
parents:
diff changeset
    47
48194c26a46c Initial revision
claus
parents:
diff changeset
    48
Instance variables:
48194c26a46c Initial revision
claus
parents:
diff changeset
    49
48194c26a46c Initial revision
claus
parents:
diff changeset
    50
superView               <aView>                 my superview i.e. the view I am in
48194c26a46c Initial revision
claus
parents:
diff changeset
    51
subViews                <aCollection>           the collection of subviews
48194c26a46c Initial revision
claus
parents:
diff changeset
    52
transformation          <WindowingTransformation>
48194c26a46c Initial revision
claus
parents:
diff changeset
    53
window                  <Rectangle>             my window i.e. local coordinate-system
48194c26a46c Initial revision
claus
parents:
diff changeset
    54
viewport                <Rectangle>             my Rectangle in superviews coordinates
48194c26a46c Initial revision
claus
parents:
diff changeset
    55
borderColor             <Color>                 color of border
48194c26a46c Initial revision
claus
parents:
diff changeset
    56
borderWidth             <Number>                borderWidth in pixels (device dep.)
48194c26a46c Initial revision
claus
parents:
diff changeset
    57
borderShape             <Form>                  shape of border (if device supports it)
48194c26a46c Initial revision
claus
parents:
diff changeset
    58
viewShape               <Form>                  shape of view (if device supports it)
48194c26a46c Initial revision
claus
parents:
diff changeset
    59
top                     <Number>                top coordinate in superview
48194c26a46c Initial revision
claus
parents:
diff changeset
    60
left                    <Number>                left coordinate in superview
48194c26a46c Initial revision
claus
parents:
diff changeset
    61
extendChanged           <Boolean>               true if extend changed during setup
48194c26a46c Initial revision
claus
parents:
diff changeset
    62
originChanged           <Boolean>               true if origin changed during setup
48194c26a46c Initial revision
claus
parents:
diff changeset
    63
relativeOrigin          <Number>                relative origin in percent within superview
48194c26a46c Initial revision
claus
parents:
diff changeset
    64
relativeExtent          <Number>                relative extent in percent within superview
48194c26a46c Initial revision
claus
parents:
diff changeset
    65
originRule              <Block>                 rule to compute origin if superview changes size
48194c26a46c Initial revision
claus
parents:
diff changeset
    66
extentRule              <Block>                 rule to compute extent if superview changes size
48194c26a46c Initial revision
claus
parents:
diff changeset
    67
shown                   <Boolean>               true if visible (false if iconified)
48194c26a46c Initial revision
claus
parents:
diff changeset
    68
hidden                  <Boolean>               dont show automatically when superview is realized
48194c26a46c Initial revision
claus
parents:
diff changeset
    69
name                    <String>                my name (future use for resources)
48194c26a46c Initial revision
claus
parents:
diff changeset
    70
level                   <Number>                3D level relative to superview
48194c26a46c Initial revision
claus
parents:
diff changeset
    71
margin                  <Number>                convenient margin
48194c26a46c Initial revision
claus
parents:
diff changeset
    72
innerClipRect           <Rectangle>             convenient inner clip (minus margin)
48194c26a46c Initial revision
claus
parents:
diff changeset
    73
shadowColor             <Color>                 color used to draw 3D shadowed edges
48194c26a46c Initial revision
claus
parents:
diff changeset
    74
lightColor              <Color>                 color used to draw 3D lighted edges
48194c26a46c Initial revision
claus
parents:
diff changeset
    75
viewOrigin              <Point>                 origin within model
48194c26a46c Initial revision
claus
parents:
diff changeset
    76
contentsChanngeAction   <Block>                 action to perform when model contents changes
48194c26a46c Initial revision
claus
parents:
diff changeset
    77
originChangeAction      <Block>                 action to perform when model origin changes
48194c26a46c Initial revision
claus
parents:
diff changeset
    78
bitGravity              <Symbol>                gravity of contents (if device supports it)
48194c26a46c Initial revision
claus
parents:
diff changeset
    79
viewGravity             <Symbol>                gravity of view (if device supports it)
48194c26a46c Initial revision
claus
parents:
diff changeset
    80
keyboardHandler         <anObject>              gets keyboard input if non-nil
48194c26a46c Initial revision
claus
parents:
diff changeset
    81
model                   <anObject>              the model (if MVC is used)
48194c26a46c Initial revision
claus
parents:
diff changeset
    82
controller              <aController>           the controller - gets events (if MVC is used)
48194c26a46c Initial revision
claus
parents:
diff changeset
    83
48194c26a46c Initial revision
claus
parents:
diff changeset
    84
Class variables:
48194c26a46c Initial revision
claus
parents:
diff changeset
    85
48194c26a46c Initial revision
claus
parents:
diff changeset
    86
Grey                    <Color>                 the color grey - its used so often
48194c26a46c Initial revision
claus
parents:
diff changeset
    87
ViewSpacing             <Number>                the number of pixels in a millimeter (prefered
48194c26a46c Initial revision
claus
parents:
diff changeset
    88
                                                spacing between views)
48194c26a46c Initial revision
claus
parents:
diff changeset
    89
ZeroPoint               <Point>                 0 @ 0 - its used so often
48194c26a46c Initial revision
claus
parents:
diff changeset
    90
CentPoint               <Point>                 100 @ 100 - its used so often
48194c26a46c Initial revision
claus
parents:
diff changeset
    91
48194c26a46c Initial revision
claus
parents:
diff changeset
    92
%W% %E%
48194c26a46c Initial revision
claus
parents:
diff changeset
    93
48194c26a46c Initial revision
claus
parents:
diff changeset
    94
written spring/summer 89 by claus
48194c26a46c Initial revision
claus
parents:
diff changeset
    95
3D effects summer 90 by claus
48194c26a46c Initial revision
claus
parents:
diff changeset
    96
MVC, viewport and window stuff summer 92 by claus (for ST-80 compatibility)
48194c26a46c Initial revision
claus
parents:
diff changeset
    97
'!
48194c26a46c Initial revision
claus
parents:
diff changeset
    98
48194c26a46c Initial revision
claus
parents:
diff changeset
    99
"this flag controls (globally) how views look"
48194c26a46c Initial revision
claus
parents:
diff changeset
   100
48194c26a46c Initial revision
claus
parents:
diff changeset
   101
Smalltalk at:#View3D put:false!
48194c26a46c Initial revision
claus
parents:
diff changeset
   102
48194c26a46c Initial revision
claus
parents:
diff changeset
   103
!View class methodsFor:'initialization'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   104
48194c26a46c Initial revision
claus
parents:
diff changeset
   105
initialize
48194c26a46c Initial revision
claus
parents:
diff changeset
   106
    "Workstation initialize."
48194c26a46c Initial revision
claus
parents:
diff changeset
   107
48194c26a46c Initial revision
claus
parents:
diff changeset
   108
    super initialize.
48194c26a46c Initial revision
claus
parents:
diff changeset
   109
48194c26a46c Initial revision
claus
parents:
diff changeset
   110
    Resources := ResourcePack for:self.
48194c26a46c Initial revision
claus
parents:
diff changeset
   111
48194c26a46c Initial revision
claus
parents:
diff changeset
   112
    Form initialize.
48194c26a46c Initial revision
claus
parents:
diff changeset
   113
    Color initialize.
48194c26a46c Initial revision
claus
parents:
diff changeset
   114
48194c26a46c Initial revision
claus
parents:
diff changeset
   115
    Grey := Resource name:'VIEW_GREY'
48194c26a46c Initial revision
claus
parents:
diff changeset
   116
                  default:nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   117
                 fromFile:'Smalltalk.rs'.
48194c26a46c Initial revision
claus
parents:
diff changeset
   118
    Grey isNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   119
        Grey := Color grey
48194c26a46c Initial revision
claus
parents:
diff changeset
   120
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   121
    DefaultStyle := Resource name:'VIEW_STYLE' 
48194c26a46c Initial revision
claus
parents:
diff changeset
   122
                          default:(View3D ifTrue:[#view3D] ifFalse:[#normal]) 
48194c26a46c Initial revision
claus
parents:
diff changeset
   123
                         fromFile:'Smalltalk.rs'
48194c26a46c Initial revision
claus
parents:
diff changeset
   124
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   125
48194c26a46c Initial revision
claus
parents:
diff changeset
   126
!View class methodsFor:'defaults'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   127
48194c26a46c Initial revision
claus
parents:
diff changeset
   128
defaultExtent
48194c26a46c Initial revision
claus
parents:
diff changeset
   129
    "define the default extent"
48194c26a46c Initial revision
claus
parents:
diff changeset
   130
48194c26a46c Initial revision
claus
parents:
diff changeset
   131
    CentPoint isNil ifTrue:[CentPoint := 100 @ 100].
48194c26a46c Initial revision
claus
parents:
diff changeset
   132
    ^ CentPoint
48194c26a46c Initial revision
claus
parents:
diff changeset
   133
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   134
48194c26a46c Initial revision
claus
parents:
diff changeset
   135
defaultStyle
48194c26a46c Initial revision
claus
parents:
diff changeset
   136
    ^ DefaultStyle
48194c26a46c Initial revision
claus
parents:
diff changeset
   137
48194c26a46c Initial revision
claus
parents:
diff changeset
   138
    "View defaultStyle"
48194c26a46c Initial revision
claus
parents:
diff changeset
   139
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   140
48194c26a46c Initial revision
claus
parents:
diff changeset
   141
defaultStyle:aStyle
48194c26a46c Initial revision
claus
parents:
diff changeset
   142
    DefaultStyle := aStyle
48194c26a46c Initial revision
claus
parents:
diff changeset
   143
48194c26a46c Initial revision
claus
parents:
diff changeset
   144
    "View defaultStyle:#next"
48194c26a46c Initial revision
claus
parents:
diff changeset
   145
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   146
48194c26a46c Initial revision
claus
parents:
diff changeset
   147
!View class methodsFor:'instance creation'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   148
48194c26a46c Initial revision
claus
parents:
diff changeset
   149
in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   150
    "return a new view as a subview of aView"
48194c26a46c Initial revision
claus
parents:
diff changeset
   151
48194c26a46c Initial revision
claus
parents:
diff changeset
   152
    |newView|
48194c26a46c Initial revision
claus
parents:
diff changeset
   153
48194c26a46c Initial revision
claus
parents:
diff changeset
   154
    newView := self basicNew.
48194c26a46c Initial revision
claus
parents:
diff changeset
   155
    newView device:(aView device).
48194c26a46c Initial revision
claus
parents:
diff changeset
   156
    newView superView:(aView).
48194c26a46c Initial revision
claus
parents:
diff changeset
   157
    newView initialize.
48194c26a46c Initial revision
claus
parents:
diff changeset
   158
    aView addSubView:newView.
48194c26a46c Initial revision
claus
parents:
diff changeset
   159
    ^ newView
48194c26a46c Initial revision
claus
parents:
diff changeset
   160
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   161
48194c26a46c Initial revision
claus
parents:
diff changeset
   162
extent:extent in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   163
    "create a new view as a subview of aView with given extent"
48194c26a46c Initial revision
claus
parents:
diff changeset
   164
48194c26a46c Initial revision
claus
parents:
diff changeset
   165
    ^ self origin:nil extent:extent borderWidth:nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   166
                      font:nil label:nil in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   167
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   168
48194c26a46c Initial revision
claus
parents:
diff changeset
   169
origin:origin in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   170
    "create a new view as a subview of aView with given origin"
48194c26a46c Initial revision
claus
parents:
diff changeset
   171
48194c26a46c Initial revision
claus
parents:
diff changeset
   172
    ^ self origin:origin extent:nil borderWidth:nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   173
                         font:nil label:nil in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   174
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   175
48194c26a46c Initial revision
claus
parents:
diff changeset
   176
extent:extent
48194c26a46c Initial revision
claus
parents:
diff changeset
   177
    "create a new view with given extent"
48194c26a46c Initial revision
claus
parents:
diff changeset
   178
48194c26a46c Initial revision
claus
parents:
diff changeset
   179
    ^ self origin:nil extent:extent borderWidth:nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   180
                      font:nil label:nil in:nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   181
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   182
48194c26a46c Initial revision
claus
parents:
diff changeset
   183
origin:origin extent:extent
48194c26a46c Initial revision
claus
parents:
diff changeset
   184
    "create a new view with given origin and extent"
48194c26a46c Initial revision
claus
parents:
diff changeset
   185
48194c26a46c Initial revision
claus
parents:
diff changeset
   186
    ^ self origin:origin extent:extent borderWidth:nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   187
                         font:nil label:nil in:nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   188
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   189
48194c26a46c Initial revision
claus
parents:
diff changeset
   190
origin:origin extent:extent in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   191
    "create a new view as a subview of aView with given origin and extent"
48194c26a46c Initial revision
claus
parents:
diff changeset
   192
48194c26a46c Initial revision
claus
parents:
diff changeset
   193
    ^ self origin:origin extent:extent borderWidth:nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   194
                         font:nil label:nil in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   195
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   196
48194c26a46c Initial revision
claus
parents:
diff changeset
   197
origin:origin extent:extent borderWidth:bw in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   198
    "create a new view as a subview of aView with given origin, extent
48194c26a46c Initial revision
claus
parents:
diff changeset
   199
     and borderWidth"
48194c26a46c Initial revision
claus
parents:
diff changeset
   200
48194c26a46c Initial revision
claus
parents:
diff changeset
   201
    ^ self origin:origin extent:extent borderWidth:bw
48194c26a46c Initial revision
claus
parents:
diff changeset
   202
                         font:nil label:nil in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   203
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   204
48194c26a46c Initial revision
claus
parents:
diff changeset
   205
origin:origin extent:extent borderWidth:bw
48194c26a46c Initial revision
claus
parents:
diff changeset
   206
    "create a new view with given origin, extent and borderWidth"
48194c26a46c Initial revision
claus
parents:
diff changeset
   207
48194c26a46c Initial revision
claus
parents:
diff changeset
   208
    ^ self origin:origin extent:extent borderWidth:bw
48194c26a46c Initial revision
claus
parents:
diff changeset
   209
                         font:nil label:nil in:nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   210
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   211
48194c26a46c Initial revision
claus
parents:
diff changeset
   212
label:label
48194c26a46c Initial revision
claus
parents:
diff changeset
   213
    "create a new view with given label"
48194c26a46c Initial revision
claus
parents:
diff changeset
   214
48194c26a46c Initial revision
claus
parents:
diff changeset
   215
    ^ self origin:nil extent:nil borderWidth:nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   216
                      font:nil label:label in:nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   217
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   218
48194c26a46c Initial revision
claus
parents:
diff changeset
   219
label:label in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   220
    "create a new view as subview of aView with given label"
48194c26a46c Initial revision
claus
parents:
diff changeset
   221
48194c26a46c Initial revision
claus
parents:
diff changeset
   222
    ^ self origin:nil extent:nil borderWidth:nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   223
                      font:nil label:label in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   224
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   225
48194c26a46c Initial revision
claus
parents:
diff changeset
   226
extent:extent label:label
48194c26a46c Initial revision
claus
parents:
diff changeset
   227
    "create a new view with given extent and label"
48194c26a46c Initial revision
claus
parents:
diff changeset
   228
48194c26a46c Initial revision
claus
parents:
diff changeset
   229
    ^ self origin:nil extent:extent borderWidth:nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   230
                      font:nil label:label in:nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   231
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   232
48194c26a46c Initial revision
claus
parents:
diff changeset
   233
origin:origin extent:extent label:label
48194c26a46c Initial revision
claus
parents:
diff changeset
   234
    "create a new view with given origin, extent and label"
48194c26a46c Initial revision
claus
parents:
diff changeset
   235
48194c26a46c Initial revision
claus
parents:
diff changeset
   236
    ^ self origin:origin extent:extent borderWidth:nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   237
                         font:nil label:label in:nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   238
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   239
48194c26a46c Initial revision
claus
parents:
diff changeset
   240
origin:origin extent:extent font:aFont label:label
48194c26a46c Initial revision
claus
parents:
diff changeset
   241
    ^ self origin:origin extent:extent borderWidth:nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   242
                         font:nil label:label in:nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   243
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   244
48194c26a46c Initial revision
claus
parents:
diff changeset
   245
origin:origin extent:extent font:aFont label:label in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   246
    ^ self origin:origin extent:extent borderWidth:nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   247
                         font:aFont label:label in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   248
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   249
48194c26a46c Initial revision
claus
parents:
diff changeset
   250
origin:anOrigin extent:anExtent
48194c26a46c Initial revision
claus
parents:
diff changeset
   251
                label:aLabel icon:aForm
48194c26a46c Initial revision
claus
parents:
diff changeset
   252
                minExtent:minExtent maxExtent:maxExtent
48194c26a46c Initial revision
claus
parents:
diff changeset
   253
    |newView|
48194c26a46c Initial revision
claus
parents:
diff changeset
   254
48194c26a46c Initial revision
claus
parents:
diff changeset
   255
    newView := self on:Display.
48194c26a46c Initial revision
claus
parents:
diff changeset
   256
    anOrigin notNil ifTrue:[newView origin:anOrigin].
48194c26a46c Initial revision
claus
parents:
diff changeset
   257
    anExtent notNil ifTrue:[newView extent:anExtent].
48194c26a46c Initial revision
claus
parents:
diff changeset
   258
    aLabel notNil ifTrue:[newView label:aLabel].
48194c26a46c Initial revision
claus
parents:
diff changeset
   259
    aForm notNil ifTrue:[newView icon:aForm].
48194c26a46c Initial revision
claus
parents:
diff changeset
   260
    minExtent notNil ifTrue:[newView minExtent:minExtent].
48194c26a46c Initial revision
claus
parents:
diff changeset
   261
    maxExtent notNil ifTrue:[newView maxExtent:maxExtent].
48194c26a46c Initial revision
claus
parents:
diff changeset
   262
    ^ newView
48194c26a46c Initial revision
claus
parents:
diff changeset
   263
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   264
48194c26a46c Initial revision
claus
parents:
diff changeset
   265
origin:anOrigin extent:anExtent borderWidth:bw
48194c26a46c Initial revision
claus
parents:
diff changeset
   266
                font:aFont label:aLabel in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   267
    |newView|
48194c26a46c Initial revision
claus
parents:
diff changeset
   268
48194c26a46c Initial revision
claus
parents:
diff changeset
   269
    aView notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   270
        newView := self basicNew.
48194c26a46c Initial revision
claus
parents:
diff changeset
   271
        newView device:(aView device).
48194c26a46c Initial revision
claus
parents:
diff changeset
   272
        aView addSubView:newView.
48194c26a46c Initial revision
claus
parents:
diff changeset
   273
        newView initialize
48194c26a46c Initial revision
claus
parents:
diff changeset
   274
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   275
        newView := self on:Display
48194c26a46c Initial revision
claus
parents:
diff changeset
   276
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   277
    bw notNil ifTrue:[newView borderWidth:bw].
48194c26a46c Initial revision
claus
parents:
diff changeset
   278
    anExtent notNil ifTrue:[newView extent:anExtent].
48194c26a46c Initial revision
claus
parents:
diff changeset
   279
    anOrigin notNil ifTrue:[newView origin:anOrigin].
48194c26a46c Initial revision
claus
parents:
diff changeset
   280
    aFont notNil ifTrue:[newView font:aFont].
48194c26a46c Initial revision
claus
parents:
diff changeset
   281
    aLabel notNil ifTrue:[newView label:aLabel].
48194c26a46c Initial revision
claus
parents:
diff changeset
   282
    ^ newView
48194c26a46c Initial revision
claus
parents:
diff changeset
   283
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   284
48194c26a46c Initial revision
claus
parents:
diff changeset
   285
origin:origin corner:corner 
48194c26a46c Initial revision
claus
parents:
diff changeset
   286
    "create a new view with given origin and extent"
48194c26a46c Initial revision
claus
parents:
diff changeset
   287
48194c26a46c Initial revision
claus
parents:
diff changeset
   288
    ^ self origin:origin corner:corner borderWidth:nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   289
                         font:nil label:nil in:nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   290
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   291
48194c26a46c Initial revision
claus
parents:
diff changeset
   292
origin:origin corner:corner in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   293
    "create a new view as a subview of aView with given origin and extent"
48194c26a46c Initial revision
claus
parents:
diff changeset
   294
48194c26a46c Initial revision
claus
parents:
diff changeset
   295
    ^ self origin:origin corner:corner borderWidth:nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   296
                         font:nil label:nil in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   297
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   298
48194c26a46c Initial revision
claus
parents:
diff changeset
   299
origin:origin corner:corner borderWidth:bw in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   300
    "create a new view as a subview of aView with given origin and extent"
48194c26a46c Initial revision
claus
parents:
diff changeset
   301
48194c26a46c Initial revision
claus
parents:
diff changeset
   302
    ^ self origin:origin corner:corner borderWidth:bw
48194c26a46c Initial revision
claus
parents:
diff changeset
   303
                         font:nil label:nil in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   304
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   305
48194c26a46c Initial revision
claus
parents:
diff changeset
   306
origin:anOrigin corner:aCorner borderWidth:bw
48194c26a46c Initial revision
claus
parents:
diff changeset
   307
                font:aFont label:aLabel in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   308
    |newView|
48194c26a46c Initial revision
claus
parents:
diff changeset
   309
48194c26a46c Initial revision
claus
parents:
diff changeset
   310
    aView notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   311
        newView := self basicNew.
48194c26a46c Initial revision
claus
parents:
diff changeset
   312
        newView device:(aView device).
48194c26a46c Initial revision
claus
parents:
diff changeset
   313
        aView addSubView:newView.
48194c26a46c Initial revision
claus
parents:
diff changeset
   314
        newView initialize
48194c26a46c Initial revision
claus
parents:
diff changeset
   315
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   316
        newView := self on:Display
48194c26a46c Initial revision
claus
parents:
diff changeset
   317
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   318
    bw notNil ifTrue:[newView borderWidth:bw].
48194c26a46c Initial revision
claus
parents:
diff changeset
   319
    anOrigin notNil ifTrue:[newView origin:anOrigin].
48194c26a46c Initial revision
claus
parents:
diff changeset
   320
    aCorner notNil ifTrue:[newView corner:aCorner].
48194c26a46c Initial revision
claus
parents:
diff changeset
   321
    aFont notNil ifTrue:[newView font:aFont].
48194c26a46c Initial revision
claus
parents:
diff changeset
   322
    aLabel notNil ifTrue:[newView label:aLabel].
48194c26a46c Initial revision
claus
parents:
diff changeset
   323
    ^ newView
48194c26a46c Initial revision
claus
parents:
diff changeset
   324
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   325
48194c26a46c Initial revision
claus
parents:
diff changeset
   326
on:anObject aspect:aspectMsg change:changeMsg menu:menuMsg
48194c26a46c Initial revision
claus
parents:
diff changeset
   327
    ^ self new on:anObject
48194c26a46c Initial revision
claus
parents:
diff changeset
   328
           aspect:aspectMsg
48194c26a46c Initial revision
claus
parents:
diff changeset
   329
           change:changeMsg
48194c26a46c Initial revision
claus
parents:
diff changeset
   330
             menu:menuMsg
48194c26a46c Initial revision
claus
parents:
diff changeset
   331
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   332
48194c26a46c Initial revision
claus
parents:
diff changeset
   333
model:aModel
48194c26a46c Initial revision
claus
parents:
diff changeset
   334
    ^ self new model:aModel
48194c26a46c Initial revision
claus
parents:
diff changeset
   335
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   336
48194c26a46c Initial revision
claus
parents:
diff changeset
   337
!View methodsFor:'initialization'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   338
48194c26a46c Initial revision
claus
parents:
diff changeset
   339
initialize
48194c26a46c Initial revision
claus
parents:
diff changeset
   340
    |ext|
48194c26a46c Initial revision
claus
parents:
diff changeset
   341
48194c26a46c Initial revision
claus
parents:
diff changeset
   342
    super initialize.
48194c26a46c Initial revision
claus
parents:
diff changeset
   343
    shown := false.
48194c26a46c Initial revision
claus
parents:
diff changeset
   344
48194c26a46c Initial revision
claus
parents:
diff changeset
   345
    "fill in some defaults - some of them are usually redefined in subclasses
48194c26a46c Initial revision
claus
parents:
diff changeset
   346
     initialize methods"
48194c26a46c Initial revision
claus
parents:
diff changeset
   347
48194c26a46c Initial revision
claus
parents:
diff changeset
   348
    name := self class name.
48194c26a46c Initial revision
claus
parents:
diff changeset
   349
    ext := self class defaultExtent.
48194c26a46c Initial revision
claus
parents:
diff changeset
   350
48194c26a46c Initial revision
claus
parents:
diff changeset
   351
    level := 0.
48194c26a46c Initial revision
claus
parents:
diff changeset
   352
    margin := 0.
48194c26a46c Initial revision
claus
parents:
diff changeset
   353
    softEdge := false.
48194c26a46c Initial revision
claus
parents:
diff changeset
   354
48194c26a46c Initial revision
claus
parents:
diff changeset
   355
    self initStyle.
48194c26a46c Initial revision
claus
parents:
diff changeset
   356
48194c26a46c Initial revision
claus
parents:
diff changeset
   357
    left := 0.
48194c26a46c Initial revision
claus
parents:
diff changeset
   358
    top := 0.
48194c26a46c Initial revision
claus
parents:
diff changeset
   359
    width := ext x.
48194c26a46c Initial revision
claus
parents:
diff changeset
   360
    height := ext y.
48194c26a46c Initial revision
claus
parents:
diff changeset
   361
    ZeroPoint isNil ifTrue:[ZeroPoint := 0 @ 0].
48194c26a46c Initial revision
claus
parents:
diff changeset
   362
    viewOrigin := ZeroPoint.
48194c26a46c Initial revision
claus
parents:
diff changeset
   363
    ViewSpacing isNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   364
        ViewSpacing := Display verticalPixelPerMillimeter rounded
48194c26a46c Initial revision
claus
parents:
diff changeset
   365
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   366
    originChanged := false.
48194c26a46c Initial revision
claus
parents:
diff changeset
   367
    extentChanged := false.
48194c26a46c Initial revision
claus
parents:
diff changeset
   368
    bitGravity := nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
   369
    viewGravity := nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
   370
48194c26a46c Initial revision
claus
parents:
diff changeset
   371
    "ST-80 compatibility; if I define a defaultController
48194c26a46c Initial revision
claus
parents:
diff changeset
   372
     create one and set it up; otherwise do nothing"
48194c26a46c Initial revision
claus
parents:
diff changeset
   373
48194c26a46c Initial revision
claus
parents:
diff changeset
   374
    (self respondsTo:#defaultControllerClass) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   375
        self defaultControllerClass notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   376
            controller := self defaultControllerClass basicNew.
48194c26a46c Initial revision
claus
parents:
diff changeset
   377
            controller view:self.
48194c26a46c Initial revision
claus
parents:
diff changeset
   378
            controller initialize
48194c26a46c Initial revision
claus
parents:
diff changeset
   379
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   380
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   381
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   382
48194c26a46c Initial revision
claus
parents:
diff changeset
   383
initStyle
48194c26a46c Initial revision
claus
parents:
diff changeset
   384
    style := DefaultStyle.
48194c26a46c Initial revision
claus
parents:
diff changeset
   385
48194c26a46c Initial revision
claus
parents:
diff changeset
   386
    self is3D ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   387
        borderWidth := 0
48194c26a46c Initial revision
claus
parents:
diff changeset
   388
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   389
        borderWidth := 1
48194c26a46c Initial revision
claus
parents:
diff changeset
   390
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   391
48194c26a46c Initial revision
claus
parents:
diff changeset
   392
    (self is3D and:[device hasGreyscales]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   393
        viewBackground := Grey.
48194c26a46c Initial revision
claus
parents:
diff changeset
   394
        lightColor := White.
48194c26a46c Initial revision
claus
parents:
diff changeset
   395
        shadowColor := Black.
48194c26a46c Initial revision
claus
parents:
diff changeset
   396
        halfShadowColor := Color darkGrey.
48194c26a46c Initial revision
claus
parents:
diff changeset
   397
        halfLightColor := White.
48194c26a46c Initial revision
claus
parents:
diff changeset
   398
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   399
        viewBackground := White.
48194c26a46c Initial revision
claus
parents:
diff changeset
   400
        lightColor := Color grey 
48194c26a46c Initial revision
claus
parents:
diff changeset
   401
                      "or White" 
48194c26a46c Initial revision
claus
parents:
diff changeset
   402
                      "or Color lightGrey".    "cant say which is better ..."
48194c26a46c Initial revision
claus
parents:
diff changeset
   403
        shadowColor := Black.
48194c26a46c Initial revision
claus
parents:
diff changeset
   404
        halfShadowColor := Color grey.
48194c26a46c Initial revision
claus
parents:
diff changeset
   405
        halfLightColor := White.
48194c26a46c Initial revision
claus
parents:
diff changeset
   406
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   407
48194c26a46c Initial revision
claus
parents:
diff changeset
   408
    borderColor := Black.
48194c26a46c Initial revision
claus
parents:
diff changeset
   409
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   410
48194c26a46c Initial revision
claus
parents:
diff changeset
   411
initEvents
48194c26a46c Initial revision
claus
parents:
diff changeset
   412
    "will be sent by create - can be redefined by subclasses to enable
48194c26a46c Initial revision
claus
parents:
diff changeset
   413
     view events"
48194c26a46c Initial revision
claus
parents:
diff changeset
   414
48194c26a46c Initial revision
claus
parents:
diff changeset
   415
    ^ self
48194c26a46c Initial revision
claus
parents:
diff changeset
   416
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   417
48194c26a46c Initial revision
claus
parents:
diff changeset
   418
reinitialize
48194c26a46c Initial revision
claus
parents:
diff changeset
   419
    "this is called right after snapIn"
48194c26a46c Initial revision
claus
parents:
diff changeset
   420
48194c26a46c Initial revision
claus
parents:
diff changeset
   421
    |myController|
48194c26a46c Initial revision
claus
parents:
diff changeset
   422
48194c26a46c Initial revision
claus
parents:
diff changeset
   423
    "if I have already been reinited - return"
48194c26a46c Initial revision
claus
parents:
diff changeset
   424
    drawableId notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   425
        ^ self
48194c26a46c Initial revision
claus
parents:
diff changeset
   426
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   427
48194c26a46c Initial revision
claus
parents:
diff changeset
   428
    myController := controller.
48194c26a46c Initial revision
claus
parents:
diff changeset
   429
    controller := nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
   430
    self recreate.
48194c26a46c Initial revision
claus
parents:
diff changeset
   431
48194c26a46c Initial revision
claus
parents:
diff changeset
   432
    "if I was mapped, do it again"
48194c26a46c Initial revision
claus
parents:
diff changeset
   433
    realized ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   434
        "if it was iconified, try to remap iconified"
48194c26a46c Initial revision
claus
parents:
diff changeset
   435
        shown ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   436
            device mapWindow:drawableId iconified:true
48194c26a46c Initial revision
claus
parents:
diff changeset
   437
                                              atX:left y:top
48194c26a46c Initial revision
claus
parents:
diff changeset
   438
                                            width:width height:height
48194c26a46c Initial revision
claus
parents:
diff changeset
   439
        ] ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   440
            device mapWindow:drawableId iconified:false
48194c26a46c Initial revision
claus
parents:
diff changeset
   441
                                              atX:left y:top
48194c26a46c Initial revision
claus
parents:
diff changeset
   442
                                            width:width height:height
48194c26a46c Initial revision
claus
parents:
diff changeset
   443
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   444
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   445
48194c26a46c Initial revision
claus
parents:
diff changeset
   446
    "restore controller"
48194c26a46c Initial revision
claus
parents:
diff changeset
   447
    controller := myController
48194c26a46c Initial revision
claus
parents:
diff changeset
   448
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   449
48194c26a46c Initial revision
claus
parents:
diff changeset
   450
recreate
48194c26a46c Initial revision
claus
parents:
diff changeset
   451
    "recreate (i.e. tell X about me) after a snapin"
48194c26a46c Initial revision
claus
parents:
diff changeset
   452
48194c26a46c Initial revision
claus
parents:
diff changeset
   453
    drawableId isNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   454
        "associate cursor/colors to device"
48194c26a46c Initial revision
claus
parents:
diff changeset
   455
48194c26a46c Initial revision
claus
parents:
diff changeset
   456
        super recreate.
48194c26a46c Initial revision
claus
parents:
diff changeset
   457
48194c26a46c Initial revision
claus
parents:
diff changeset
   458
        borderColor notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   459
            borderColor := borderColor on:device.
48194c26a46c Initial revision
claus
parents:
diff changeset
   460
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   461
        shadowColor notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   462
            shadowColor := shadowColor on:device.
48194c26a46c Initial revision
claus
parents:
diff changeset
   463
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   464
        lightColor notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   465
            lightColor := lightColor on:device.
48194c26a46c Initial revision
claus
parents:
diff changeset
   466
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   467
        halfShadowColor notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   468
            halfShadowColor := halfShadowColor on:device.
48194c26a46c Initial revision
claus
parents:
diff changeset
   469
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   470
        halfLightColor notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   471
            halfLightColor := halfLightColor on:device.
48194c26a46c Initial revision
claus
parents:
diff changeset
   472
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   473
48194c26a46c Initial revision
claus
parents:
diff changeset
   474
        drawableId := device createWindowFor:self 
48194c26a46c Initial revision
claus
parents:
diff changeset
   475
                                        left:left top:top 
48194c26a46c Initial revision
claus
parents:
diff changeset
   476
                                       width:width height:height.
48194c26a46c Initial revision
claus
parents:
diff changeset
   477
48194c26a46c Initial revision
claus
parents:
diff changeset
   478
        extentChanged := false.
48194c26a46c Initial revision
claus
parents:
diff changeset
   479
        originChanged := false.
48194c26a46c Initial revision
claus
parents:
diff changeset
   480
48194c26a46c Initial revision
claus
parents:
diff changeset
   481
        borderShape notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   482
            device setWindowBorderShape:(borderShape id) in:drawableId
48194c26a46c Initial revision
claus
parents:
diff changeset
   483
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   484
        viewShape notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   485
            device setWindowShape:(viewShape id) in:drawableId
48194c26a46c Initial revision
claus
parents:
diff changeset
   486
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   487
        backed notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   488
            device setBackingStore:backed in:drawableId
48194c26a46c Initial revision
claus
parents:
diff changeset
   489
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   490
        saveUnder ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   491
            device setSaveUnder:saveUnder in:drawableId
48194c26a46c Initial revision
claus
parents:
diff changeset
   492
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   493
48194c26a46c Initial revision
claus
parents:
diff changeset
   494
        font := font on:device.
48194c26a46c Initial revision
claus
parents:
diff changeset
   495
48194c26a46c Initial revision
claus
parents:
diff changeset
   496
        "XXX has to be changed: eventmasks are device specific -
48194c26a46c Initial revision
claus
parents:
diff changeset
   497
         will not allow restart on another Workstation-type"
48194c26a46c Initial revision
claus
parents:
diff changeset
   498
48194c26a46c Initial revision
claus
parents:
diff changeset
   499
        device setEventMask:eventMask in:drawableId
48194c26a46c Initial revision
claus
parents:
diff changeset
   500
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   501
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   502
48194c26a46c Initial revision
claus
parents:
diff changeset
   503
!View methodsFor:'accessing-mvc'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   504
48194c26a46c Initial revision
claus
parents:
diff changeset
   505
controller
48194c26a46c Initial revision
claus
parents:
diff changeset
   506
    "return the controller. For non MVC views, return nil"
48194c26a46c Initial revision
claus
parents:
diff changeset
   507
48194c26a46c Initial revision
claus
parents:
diff changeset
   508
    ^ controller
48194c26a46c Initial revision
claus
parents:
diff changeset
   509
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   510
48194c26a46c Initial revision
claus
parents:
diff changeset
   511
controller:aController
48194c26a46c Initial revision
claus
parents:
diff changeset
   512
    "set the controller"
48194c26a46c Initial revision
claus
parents:
diff changeset
   513
48194c26a46c Initial revision
claus
parents:
diff changeset
   514
    controller := aController.
48194c26a46c Initial revision
claus
parents:
diff changeset
   515
    controller view:self.
48194c26a46c Initial revision
claus
parents:
diff changeset
   516
    controller model:model
48194c26a46c Initial revision
claus
parents:
diff changeset
   517
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   518
48194c26a46c Initial revision
claus
parents:
diff changeset
   519
model
48194c26a46c Initial revision
claus
parents:
diff changeset
   520
    "return the model, for non-MVC views,
48194c26a46c Initial revision
claus
parents:
diff changeset
   521
     this is usually the receiver"
48194c26a46c Initial revision
claus
parents:
diff changeset
   522
48194c26a46c Initial revision
claus
parents:
diff changeset
   523
    ^ model
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
48194c26a46c Initial revision
claus
parents:
diff changeset
   527
    "set the model"
48194c26a46c Initial revision
claus
parents:
diff changeset
   528
48194c26a46c Initial revision
claus
parents:
diff changeset
   529
    model notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   530
        model removeDependent:self
48194c26a46c Initial revision
claus
parents:
diff changeset
   531
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   532
    model := aModel.
48194c26a46c Initial revision
claus
parents:
diff changeset
   533
    model notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   534
        aModel addDependent:self
48194c26a46c Initial revision
claus
parents:
diff changeset
   535
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   536
    controller notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   537
        controller model:aModel
48194c26a46c Initial revision
claus
parents:
diff changeset
   538
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   539
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   540
48194c26a46c Initial revision
claus
parents:
diff changeset
   541
on: anObject aspect: aspectMsg change: changeMsg menu: menuMsg
48194c26a46c Initial revision
claus
parents:
diff changeset
   542
    self model:anObject.
48194c26a46c Initial revision
claus
parents:
diff changeset
   543
    self aspect:aspectMsg.
48194c26a46c Initial revision
claus
parents:
diff changeset
   544
    self change:changeMsg.
48194c26a46c Initial revision
claus
parents:
diff changeset
   545
    self menu:menuMsg
48194c26a46c Initial revision
claus
parents:
diff changeset
   546
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   547
48194c26a46c Initial revision
claus
parents:
diff changeset
   548
aspect:aspectMsg
48194c26a46c Initial revision
claus
parents:
diff changeset
   549
        aspectSymbol := aspectMsg
48194c26a46c Initial revision
claus
parents:
diff changeset
   550
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   551
48194c26a46c Initial revision
claus
parents:
diff changeset
   552
change:changeMsg
48194c26a46c Initial revision
claus
parents:
diff changeset
   553
        changeSymbol := changeMsg
48194c26a46c Initial revision
claus
parents:
diff changeset
   554
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   555
48194c26a46c Initial revision
claus
parents:
diff changeset
   556
menu:menuMsg
48194c26a46c Initial revision
claus
parents:
diff changeset
   557
        menuSymbol := menuMsg
48194c26a46c Initial revision
claus
parents:
diff changeset
   558
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   559
48194c26a46c Initial revision
claus
parents:
diff changeset
   560
heightOfContents
48194c26a46c Initial revision
claus
parents:
diff changeset
   561
    "return the height of the contents in pixels 
48194c26a46c Initial revision
claus
parents:
diff changeset
   562
     - defaults to views visible area here"
48194c26a46c Initial revision
claus
parents:
diff changeset
   563
48194c26a46c Initial revision
claus
parents:
diff changeset
   564
    ^ self innerHeight
48194c26a46c Initial revision
claus
parents:
diff changeset
   565
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   566
48194c26a46c Initial revision
claus
parents:
diff changeset
   567
widthOfContents
48194c26a46c Initial revision
claus
parents:
diff changeset
   568
    "return the width of the contents in pixels
48194c26a46c Initial revision
claus
parents:
diff changeset
   569
     - defaults to views visible area here"
48194c26a46c Initial revision
claus
parents:
diff changeset
   570
48194c26a46c Initial revision
claus
parents:
diff changeset
   571
    ^ self innerWidth
48194c26a46c Initial revision
claus
parents:
diff changeset
   572
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   573
48194c26a46c Initial revision
claus
parents:
diff changeset
   574
!View methodsFor:'accessing-dimensions'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   575
48194c26a46c Initial revision
claus
parents:
diff changeset
   576
left:aNumber
48194c26a46c Initial revision
claus
parents:
diff changeset
   577
    "set the x position"
48194c26a46c Initial revision
claus
parents:
diff changeset
   578
48194c26a46c Initial revision
claus
parents:
diff changeset
   579
    self origin:(aNumber @ top)
48194c26a46c Initial revision
claus
parents:
diff changeset
   580
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   581
48194c26a46c Initial revision
claus
parents:
diff changeset
   582
top:aNumber
48194c26a46c Initial revision
claus
parents:
diff changeset
   583
    "set the y position"
48194c26a46c Initial revision
claus
parents:
diff changeset
   584
48194c26a46c Initial revision
claus
parents:
diff changeset
   585
    self origin:(left @ aNumber)
48194c26a46c Initial revision
claus
parents:
diff changeset
   586
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   587
48194c26a46c Initial revision
claus
parents:
diff changeset
   588
width:aNumber
48194c26a46c Initial revision
claus
parents:
diff changeset
   589
    "set the views width in pixels"
48194c26a46c Initial revision
claus
parents:
diff changeset
   590
48194c26a46c Initial revision
claus
parents:
diff changeset
   591
    self extent:(aNumber @ height)
48194c26a46c Initial revision
claus
parents:
diff changeset
   592
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   593
48194c26a46c Initial revision
claus
parents:
diff changeset
   594
height:aNumber
48194c26a46c Initial revision
claus
parents:
diff changeset
   595
    "set the views height in pixels"
48194c26a46c Initial revision
claus
parents:
diff changeset
   596
48194c26a46c Initial revision
claus
parents:
diff changeset
   597
    self extent:(width @ aNumber)
48194c26a46c Initial revision
claus
parents:
diff changeset
   598
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   599
48194c26a46c Initial revision
claus
parents:
diff changeset
   600
innerWidth
48194c26a46c Initial revision
claus
parents:
diff changeset
   601
    "return the width of the view minus any shadow-borders"
48194c26a46c Initial revision
claus
parents:
diff changeset
   602
48194c26a46c Initial revision
claus
parents:
diff changeset
   603
    (level == 0) ifTrue:[^ width].
48194c26a46c Initial revision
claus
parents:
diff changeset
   604
    ^ width - (2 * margin)
48194c26a46c Initial revision
claus
parents:
diff changeset
   605
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   606
48194c26a46c Initial revision
claus
parents:
diff changeset
   607
innerHeight
48194c26a46c Initial revision
claus
parents:
diff changeset
   608
    "return the height of the view minus any shadow-borders"
48194c26a46c Initial revision
claus
parents:
diff changeset
   609
48194c26a46c Initial revision
claus
parents:
diff changeset
   610
    (margin == 0) ifTrue:[^ height].
48194c26a46c Initial revision
claus
parents:
diff changeset
   611
    ^ height - (2 * margin)
48194c26a46c Initial revision
claus
parents:
diff changeset
   612
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   613
48194c26a46c Initial revision
claus
parents:
diff changeset
   614
extent:extent
48194c26a46c Initial revision
claus
parents:
diff changeset
   615
    "set the views extent; extent may be:
48194c26a46c Initial revision
claus
parents:
diff changeset
   616
     a point where integer fields mean pixel-values
48194c26a46c Initial revision
claus
parents:
diff changeset
   617
     and float values mean relative-to-superview;
48194c26a46c Initial revision
claus
parents:
diff changeset
   618
     or a block returning a point"
48194c26a46c Initial revision
claus
parents:
diff changeset
   619
48194c26a46c Initial revision
claus
parents:
diff changeset
   620
    |w h e|
48194c26a46c Initial revision
claus
parents:
diff changeset
   621
48194c26a46c Initial revision
claus
parents:
diff changeset
   622
    extent isBlock ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   623
        extentRule := extent.
48194c26a46c Initial revision
claus
parents:
diff changeset
   624
        "shown "drawableId notNil"" ifTrue:[    "23-feb-93"
48194c26a46c Initial revision
claus
parents:
diff changeset
   625
            self pixelExtent:(extent value)
48194c26a46c Initial revision
claus
parents:
diff changeset
   626
        ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   627
            extentChanged := true
48194c26a46c Initial revision
claus
parents:
diff changeset
   628
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   629
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   630
        w := extent x.
48194c26a46c Initial revision
claus
parents:
diff changeset
   631
        h := extent y.
48194c26a46c Initial revision
claus
parents:
diff changeset
   632
        ((w isMemberOf:Float) or:[h isMemberOf:Float]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   633
            relativeExtent := extent.
48194c26a46c Initial revision
claus
parents:
diff changeset
   634
            e := self extentFromRelativeExtent.
48194c26a46c Initial revision
claus
parents:
diff changeset
   635
            e isNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   636
                extentChanged := true
48194c26a46c Initial revision
claus
parents:
diff changeset
   637
            ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   638
                self pixelExtent:e
48194c26a46c Initial revision
claus
parents:
diff changeset
   639
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   640
        ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   641
            self pixelExtent:extent
48194c26a46c Initial revision
claus
parents:
diff changeset
   642
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   643
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   644
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   645
48194c26a46c Initial revision
claus
parents:
diff changeset
   646
origin:origin
48194c26a46c Initial revision
claus
parents:
diff changeset
   647
    "set the views origin; origin may be:
48194c26a46c Initial revision
claus
parents:
diff changeset
   648
     a point where integer fields mean pixel-values
48194c26a46c Initial revision
claus
parents:
diff changeset
   649
     and float values mean relative-to-superview;
48194c26a46c Initial revision
claus
parents:
diff changeset
   650
     or a block returning a point"
48194c26a46c Initial revision
claus
parents:
diff changeset
   651
48194c26a46c Initial revision
claus
parents:
diff changeset
   652
    |newLeft newTop o|
48194c26a46c Initial revision
claus
parents:
diff changeset
   653
48194c26a46c Initial revision
claus
parents:
diff changeset
   654
    origin isBlock ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   655
        originRule := origin.
48194c26a46c Initial revision
claus
parents:
diff changeset
   656
        drawableId notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   657
            self pixelOrigin:(origin value)
48194c26a46c Initial revision
claus
parents:
diff changeset
   658
        ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   659
            originChanged := true
48194c26a46c Initial revision
claus
parents:
diff changeset
   660
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   661
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   662
        newLeft := origin x.
48194c26a46c Initial revision
claus
parents:
diff changeset
   663
        newTop := origin y.
48194c26a46c Initial revision
claus
parents:
diff changeset
   664
        ((newLeft isMemberOf:Float) or:[newTop isMemberOf:Float]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   665
            relativeOrigin := origin.
48194c26a46c Initial revision
claus
parents:
diff changeset
   666
            o := self originFromRelativeOrigin.
48194c26a46c Initial revision
claus
parents:
diff changeset
   667
            o isNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   668
                originChanged := true
48194c26a46c Initial revision
claus
parents:
diff changeset
   669
            ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   670
                self pixelOrigin:o
48194c26a46c Initial revision
claus
parents:
diff changeset
   671
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   672
        ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   673
            self pixelOrigin:origin
48194c26a46c Initial revision
claus
parents:
diff changeset
   674
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   675
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   676
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   677
48194c26a46c Initial revision
claus
parents:
diff changeset
   678
origin:origin corner:corner 
48194c26a46c Initial revision
claus
parents:
diff changeset
   679
    "set both origin and extent"
48194c26a46c Initial revision
claus
parents:
diff changeset
   680
48194c26a46c Initial revision
claus
parents:
diff changeset
   681
    |newLeft newTop newRight newBot|
48194c26a46c Initial revision
claus
parents:
diff changeset
   682
48194c26a46c Initial revision
claus
parents:
diff changeset
   683
    "do it as one operation if possible"
48194c26a46c Initial revision
claus
parents:
diff changeset
   684
48194c26a46c Initial revision
claus
parents:
diff changeset
   685
    origin isBlock ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   686
        corner isBlock ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   687
            newLeft := origin x.
48194c26a46c Initial revision
claus
parents:
diff changeset
   688
            (newLeft isMemberOf:Float) ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   689
                newTop := origin y.
48194c26a46c Initial revision
claus
parents:
diff changeset
   690
                (newTop isMemberOf:Float) ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   691
                    newRight := corner x.
48194c26a46c Initial revision
claus
parents:
diff changeset
   692
                    (newRight isMemberOf:Float) ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   693
                        newBot := corner y.
48194c26a46c Initial revision
claus
parents:
diff changeset
   694
                        (newBot isMemberOf:Float) ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   695
                            self pixelOrigin:origin corner:corner 
48194c26a46c Initial revision
claus
parents:
diff changeset
   696
                        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   697
                    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   698
                ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   699
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   700
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   701
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   702
    self origin:origin.
48194c26a46c Initial revision
claus
parents:
diff changeset
   703
    self corner:corner 
48194c26a46c Initial revision
claus
parents:
diff changeset
   704
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   705
48194c26a46c Initial revision
claus
parents:
diff changeset
   706
origin:origin extent:extent
48194c26a46c Initial revision
claus
parents:
diff changeset
   707
    "set both origin and extent"
48194c26a46c Initial revision
claus
parents:
diff changeset
   708
48194c26a46c Initial revision
claus
parents:
diff changeset
   709
    |newLeft newTop newWidth newHeight|
48194c26a46c Initial revision
claus
parents:
diff changeset
   710
48194c26a46c Initial revision
claus
parents:
diff changeset
   711
    "do it as one operation if possible"
48194c26a46c Initial revision
claus
parents:
diff changeset
   712
48194c26a46c Initial revision
claus
parents:
diff changeset
   713
    origin isBlock ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   714
        extent isBlock ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   715
            newLeft := origin x.
48194c26a46c Initial revision
claus
parents:
diff changeset
   716
            (newLeft isMemberOf:Float) ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   717
                newTop := origin y.
48194c26a46c Initial revision
claus
parents:
diff changeset
   718
                (newTop isMemberOf:Float) ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   719
                    newWidth := extent x.
48194c26a46c Initial revision
claus
parents:
diff changeset
   720
                    (newWidth isMemberOf:Float) ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   721
                        newHeight := extent y.
48194c26a46c Initial revision
claus
parents:
diff changeset
   722
                        (newHeight isMemberOf:Float) ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   723
                            self pixelOrigin:origin extent:extent
48194c26a46c Initial revision
claus
parents:
diff changeset
   724
                        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   725
                    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   726
                ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   727
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   728
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   729
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   730
    self extent:extent.
48194c26a46c Initial revision
claus
parents:
diff changeset
   731
    self origin:origin
48194c26a46c Initial revision
claus
parents:
diff changeset
   732
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   733
48194c26a46c Initial revision
claus
parents:
diff changeset
   734
left:newLeft top:newTop width:newWidth height:newHeight
48194c26a46c Initial revision
claus
parents:
diff changeset
   735
    "another way of specifying origin and extent"
48194c26a46c Initial revision
claus
parents:
diff changeset
   736
48194c26a46c Initial revision
claus
parents:
diff changeset
   737
    self origin:(newLeft @ newTop) extent:(newWidth @ newHeight)
48194c26a46c Initial revision
claus
parents:
diff changeset
   738
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   739
48194c26a46c Initial revision
claus
parents:
diff changeset
   740
relativeOrigin
48194c26a46c Initial revision
claus
parents:
diff changeset
   741
    "return the relative origin or nil"
48194c26a46c Initial revision
claus
parents:
diff changeset
   742
48194c26a46c Initial revision
claus
parents:
diff changeset
   743
    ^ relativeOrigin
48194c26a46c Initial revision
claus
parents:
diff changeset
   744
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   745
48194c26a46c Initial revision
claus
parents:
diff changeset
   746
relativeCorner
48194c26a46c Initial revision
claus
parents:
diff changeset
   747
    "return the relative corner or nil"
48194c26a46c Initial revision
claus
parents:
diff changeset
   748
48194c26a46c Initial revision
claus
parents:
diff changeset
   749
    ^ relativeCorner
48194c26a46c Initial revision
claus
parents:
diff changeset
   750
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   751
48194c26a46c Initial revision
claus
parents:
diff changeset
   752
relativeExtent
48194c26a46c Initial revision
claus
parents:
diff changeset
   753
    "return the relative extent or nil"
48194c26a46c Initial revision
claus
parents:
diff changeset
   754
48194c26a46c Initial revision
claus
parents:
diff changeset
   755
    ^ relativeExtent
48194c26a46c Initial revision
claus
parents:
diff changeset
   756
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   757
48194c26a46c Initial revision
claus
parents:
diff changeset
   758
relativeOrigin:aPoint
48194c26a46c Initial revision
claus
parents:
diff changeset
   759
    "set the relative origin"
48194c26a46c Initial revision
claus
parents:
diff changeset
   760
48194c26a46c Initial revision
claus
parents:
diff changeset
   761
    relativeOrigin := aPoint
48194c26a46c Initial revision
claus
parents:
diff changeset
   762
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   763
48194c26a46c Initial revision
claus
parents:
diff changeset
   764
relativeCorner:aPoint
48194c26a46c Initial revision
claus
parents:
diff changeset
   765
    "set the relative corner"
48194c26a46c Initial revision
claus
parents:
diff changeset
   766
48194c26a46c Initial revision
claus
parents:
diff changeset
   767
    relativeCorner := aPoint
48194c26a46c Initial revision
claus
parents:
diff changeset
   768
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   769
48194c26a46c Initial revision
claus
parents:
diff changeset
   770
relativeExtent:aPoint
48194c26a46c Initial revision
claus
parents:
diff changeset
   771
    "set the relative extent"
48194c26a46c Initial revision
claus
parents:
diff changeset
   772
48194c26a46c Initial revision
claus
parents:
diff changeset
   773
    relativeExtent := aPoint
48194c26a46c Initial revision
claus
parents:
diff changeset
   774
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   775
48194c26a46c Initial revision
claus
parents:
diff changeset
   776
center:newCenter
48194c26a46c Initial revision
claus
parents:
diff changeset
   777
    "move the receiver so that newCenter, aPoint becomes the center point"
48194c26a46c Initial revision
claus
parents:
diff changeset
   778
48194c26a46c Initial revision
claus
parents:
diff changeset
   779
    self origin:(newCenter - ((width // 2) @ (height // 2)))
48194c26a46c Initial revision
claus
parents:
diff changeset
   780
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   781
48194c26a46c Initial revision
claus
parents:
diff changeset
   782
center
48194c26a46c Initial revision
claus
parents:
diff changeset
   783
    "return the point at the center of the receiver"
48194c26a46c Initial revision
claus
parents:
diff changeset
   784
48194c26a46c Initial revision
claus
parents:
diff changeset
   785
    ^ (left + (width // 2)) @ (top + (height // 2))
48194c26a46c Initial revision
claus
parents:
diff changeset
   786
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   787
48194c26a46c Initial revision
claus
parents:
diff changeset
   788
origin
48194c26a46c Initial revision
claus
parents:
diff changeset
   789
    "return the origin (in pixels)"
48194c26a46c Initial revision
claus
parents:
diff changeset
   790
48194c26a46c Initial revision
claus
parents:
diff changeset
   791
    ^ left@top
48194c26a46c Initial revision
claus
parents:
diff changeset
   792
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   793
48194c26a46c Initial revision
claus
parents:
diff changeset
   794
originRelativeTo:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   795
    "return the origin (in pixels) relative to a superView"
48194c26a46c Initial revision
claus
parents:
diff changeset
   796
48194c26a46c Initial revision
claus
parents:
diff changeset
   797
    |currentView
48194c26a46c Initial revision
claus
parents:
diff changeset
   798
     org  "{ Class: Point }"
48194c26a46c Initial revision
claus
parents:
diff changeset
   799
     sumX "{ Class: SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
   800
     sumY "{ Class: SmallInteger }" |
48194c26a46c Initial revision
claus
parents:
diff changeset
   801
48194c26a46c Initial revision
claus
parents:
diff changeset
   802
    currentView := self.
48194c26a46c Initial revision
claus
parents:
diff changeset
   803
    sumX := 0.
48194c26a46c Initial revision
claus
parents:
diff changeset
   804
    sumY := 0.
48194c26a46c Initial revision
claus
parents:
diff changeset
   805
    [currentView notNil] whileTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   806
        (currentView == aView) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   807
            ^ (sumX @ sumY)
48194c26a46c Initial revision
claus
parents:
diff changeset
   808
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   809
        org := currentView origin.
48194c26a46c Initial revision
claus
parents:
diff changeset
   810
        sumX := sumX + org x.
48194c26a46c Initial revision
claus
parents:
diff changeset
   811
        sumY := sumY + org y.
48194c26a46c Initial revision
claus
parents:
diff changeset
   812
        currentView := currentView superView
48194c26a46c Initial revision
claus
parents:
diff changeset
   813
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   814
    ^ nil
48194c26a46c Initial revision
claus
parents:
diff changeset
   815
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   816
48194c26a46c Initial revision
claus
parents:
diff changeset
   817
left
48194c26a46c Initial revision
claus
parents:
diff changeset
   818
    "return the x position of the left border"
48194c26a46c Initial revision
claus
parents:
diff changeset
   819
48194c26a46c Initial revision
claus
parents:
diff changeset
   820
    ^ left
48194c26a46c Initial revision
claus
parents:
diff changeset
   821
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   822
48194c26a46c Initial revision
claus
parents:
diff changeset
   823
right
48194c26a46c Initial revision
claus
parents:
diff changeset
   824
    "return the x position of the right border"
48194c26a46c Initial revision
claus
parents:
diff changeset
   825
48194c26a46c Initial revision
claus
parents:
diff changeset
   826
    ^ left + width - 1
48194c26a46c Initial revision
claus
parents:
diff changeset
   827
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   828
48194c26a46c Initial revision
claus
parents:
diff changeset
   829
top
48194c26a46c Initial revision
claus
parents:
diff changeset
   830
    "return the y position of the top border"
48194c26a46c Initial revision
claus
parents:
diff changeset
   831
48194c26a46c Initial revision
claus
parents:
diff changeset
   832
    ^ top
48194c26a46c Initial revision
claus
parents:
diff changeset
   833
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   834
48194c26a46c Initial revision
claus
parents:
diff changeset
   835
bottom
48194c26a46c Initial revision
claus
parents:
diff changeset
   836
    "return the y position of the bottom border"
48194c26a46c Initial revision
claus
parents:
diff changeset
   837
48194c26a46c Initial revision
claus
parents:
diff changeset
   838
    ^ top + height - 1
48194c26a46c Initial revision
claus
parents:
diff changeset
   839
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   840
48194c26a46c Initial revision
claus
parents:
diff changeset
   841
corner
48194c26a46c Initial revision
claus
parents:
diff changeset
   842
    "return the lower right corner-point"
48194c26a46c Initial revision
claus
parents:
diff changeset
   843
48194c26a46c Initial revision
claus
parents:
diff changeset
   844
    ^ (left + width - 1) @ (top + height - 1)
48194c26a46c Initial revision
claus
parents:
diff changeset
   845
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   846
48194c26a46c Initial revision
claus
parents:
diff changeset
   847
corner:corner 
48194c26a46c Initial revision
claus
parents:
diff changeset
   848
    "set the views  corner;  corner may be:
48194c26a46c Initial revision
claus
parents:
diff changeset
   849
     a point where integer fields mean pixel-values
48194c26a46c Initial revision
claus
parents:
diff changeset
   850
     and float values mean relative-to-superview;
48194c26a46c Initial revision
claus
parents:
diff changeset
   851
     or a block returning a point"
48194c26a46c Initial revision
claus
parents:
diff changeset
   852
48194c26a46c Initial revision
claus
parents:
diff changeset
   853
    |x y c|
48194c26a46c Initial revision
claus
parents:
diff changeset
   854
48194c26a46c Initial revision
claus
parents:
diff changeset
   855
    corner isBlock ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   856
        cornerRule := corner.
48194c26a46c Initial revision
claus
parents:
diff changeset
   857
        drawableId notNil ifTrue:[    
48194c26a46c Initial revision
claus
parents:
diff changeset
   858
            self pixelCorner:(corner value)
48194c26a46c Initial revision
claus
parents:
diff changeset
   859
        ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   860
            extentChanged := true
48194c26a46c Initial revision
claus
parents:
diff changeset
   861
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   862
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   863
        x := corner x.
48194c26a46c Initial revision
claus
parents:
diff changeset
   864
        y := corner y.
48194c26a46c Initial revision
claus
parents:
diff changeset
   865
        ((x isMemberOf:Float) or:[y isMemberOf:Float]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   866
            relativeCorner := corner.
48194c26a46c Initial revision
claus
parents:
diff changeset
   867
            c := self cornerFromRelativeCorner.
48194c26a46c Initial revision
claus
parents:
diff changeset
   868
            c isNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   869
                extentChanged := true
48194c26a46c Initial revision
claus
parents:
diff changeset
   870
            ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   871
                self pixelCorner:c
48194c26a46c Initial revision
claus
parents:
diff changeset
   872
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   873
        ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   874
            self pixelCorner:corner
48194c26a46c Initial revision
claus
parents:
diff changeset
   875
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   876
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   877
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   878
48194c26a46c Initial revision
claus
parents:
diff changeset
   879
!View methodsFor:'accessing-transformation'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   880
48194c26a46c Initial revision
claus
parents:
diff changeset
   881
window
48194c26a46c Initial revision
claus
parents:
diff changeset
   882
    ^ window
48194c26a46c Initial revision
claus
parents:
diff changeset
   883
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   884
48194c26a46c Initial revision
claus
parents:
diff changeset
   885
window:aRectangle
48194c26a46c Initial revision
claus
parents:
diff changeset
   886
    window := aRectangle.
48194c26a46c Initial revision
claus
parents:
diff changeset
   887
    subViews notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   888
        subViews do:[:s |
48194c26a46c Initial revision
claus
parents:
diff changeset
   889
            s superViewChangedSize
48194c26a46c Initial revision
claus
parents:
diff changeset
   890
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   891
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   892
48194c26a46c Initial revision
claus
parents:
diff changeset
   893
"
48194c26a46c Initial revision
claus
parents:
diff changeset
   894
    viewport isNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   895
        viewport := aRectangle.
48194c26a46c Initial revision
claus
parents:
diff changeset
   896
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   897
"
48194c26a46c Initial revision
claus
parents:
diff changeset
   898
"
48194c26a46c Initial revision
claus
parents:
diff changeset
   899
    superView notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   900
        self superViewChangedSize
48194c26a46c Initial revision
claus
parents:
diff changeset
   901
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   902
        originChanged := true.
48194c26a46c Initial revision
claus
parents:
diff changeset
   903
        extentChanged := true
48194c26a46c Initial revision
claus
parents:
diff changeset
   904
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   905
"
48194c26a46c Initial revision
claus
parents:
diff changeset
   906
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   907
48194c26a46c Initial revision
claus
parents:
diff changeset
   908
window:aRectangle viewport:vRect
48194c26a46c Initial revision
claus
parents:
diff changeset
   909
    window := aRectangle.
48194c26a46c Initial revision
claus
parents:
diff changeset
   910
    self viewport:vRect.
48194c26a46c Initial revision
claus
parents:
diff changeset
   911
    subViews notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   912
        subViews do:[:s |
48194c26a46c Initial revision
claus
parents:
diff changeset
   913
            s superViewChangedSize
48194c26a46c Initial revision
claus
parents:
diff changeset
   914
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   915
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   916
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   917
48194c26a46c Initial revision
claus
parents:
diff changeset
   918
transformation 
48194c26a46c Initial revision
claus
parents:
diff changeset
   919
    transformation isNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   920
        superView isNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   921
            transformation := WindowingTransformation window:window
48194c26a46c Initial revision
claus
parents:
diff changeset
   922
                                                    viewport:(0@0 extent:self extent)
48194c26a46c Initial revision
claus
parents:
diff changeset
   923
        ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   924
            window isNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   925
                window := (0 @ 0) corner:(1 @ 1)
48194c26a46c Initial revision
claus
parents:
diff changeset
   926
            ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   927
            transformation := WindowingTransformation window:window
48194c26a46c Initial revision
claus
parents:
diff changeset
   928
                                                    viewport:(self origin extent:self extent)
48194c26a46c Initial revision
claus
parents:
diff changeset
   929
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   930
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   931
    ^ transformation
48194c26a46c Initial revision
claus
parents:
diff changeset
   932
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   933
48194c26a46c Initial revision
claus
parents:
diff changeset
   934
displayTransformation
48194c26a46c Initial revision
claus
parents:
diff changeset
   935
    "ST-80 compatibility - ST/X does not draw onto the display"
48194c26a46c Initial revision
claus
parents:
diff changeset
   936
48194c26a46c Initial revision
claus
parents:
diff changeset
   937
    ^ self transformation
48194c26a46c Initial revision
claus
parents:
diff changeset
   938
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   939
48194c26a46c Initial revision
claus
parents:
diff changeset
   940
displayTransform:aPoint
48194c26a46c Initial revision
claus
parents:
diff changeset
   941
    "given a point in window coordinate, make pixel coordinate"
48194c26a46c Initial revision
claus
parents:
diff changeset
   942
48194c26a46c Initial revision
claus
parents:
diff changeset
   943
    |nx ny|
48194c26a46c Initial revision
claus
parents:
diff changeset
   944
48194c26a46c Initial revision
claus
parents:
diff changeset
   945
    nx := aPoint x - window left * width / window width.
48194c26a46c Initial revision
claus
parents:
diff changeset
   946
    ny := aPoint y - window top * height / window height.
48194c26a46c Initial revision
claus
parents:
diff changeset
   947
    ^ nx @ ny
48194c26a46c Initial revision
claus
parents:
diff changeset
   948
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   949
48194c26a46c Initial revision
claus
parents:
diff changeset
   950
inverseDisplayTransform:aPoint
48194c26a46c Initial revision
claus
parents:
diff changeset
   951
    "given a pixel coordinate, make window coordinate"
48194c26a46c Initial revision
claus
parents:
diff changeset
   952
48194c26a46c Initial revision
claus
parents:
diff changeset
   953
    |nx ny|
48194c26a46c Initial revision
claus
parents:
diff changeset
   954
48194c26a46c Initial revision
claus
parents:
diff changeset
   955
    window isNil ifTrue:[^ aPoint].
48194c26a46c Initial revision
claus
parents:
diff changeset
   956
    nx := aPoint x * window width / width + window left.
48194c26a46c Initial revision
claus
parents:
diff changeset
   957
    ny := aPoint y * window height / height + window top.
48194c26a46c Initial revision
claus
parents:
diff changeset
   958
    ^ nx @ ny
48194c26a46c Initial revision
claus
parents:
diff changeset
   959
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   960
48194c26a46c Initial revision
claus
parents:
diff changeset
   961
viewport:aRectangle
48194c26a46c Initial revision
claus
parents:
diff changeset
   962
    "define my extend in my superviews coordinate-system."
48194c26a46c Initial revision
claus
parents:
diff changeset
   963
48194c26a46c Initial revision
claus
parents:
diff changeset
   964
    |relW relH relX relY winW winH|
48194c26a46c Initial revision
claus
parents:
diff changeset
   965
48194c26a46c Initial revision
claus
parents:
diff changeset
   966
    viewport := aRectangle.
48194c26a46c Initial revision
claus
parents:
diff changeset
   967
    self dimensionFromViewport
48194c26a46c Initial revision
claus
parents:
diff changeset
   968
"
48194c26a46c Initial revision
claus
parents:
diff changeset
   969
    superView notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   970
        superView window isNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   971
            winW := 1.
48194c26a46c Initial revision
claus
parents:
diff changeset
   972
            winH := 1
48194c26a46c Initial revision
claus
parents:
diff changeset
   973
        ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   974
            winW := superView window width.
48194c26a46c Initial revision
claus
parents:
diff changeset
   975
            winH := superView window height
48194c26a46c Initial revision
claus
parents:
diff changeset
   976
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   977
        relW := (aRectangle width / winW) asFloat.
48194c26a46c Initial revision
claus
parents:
diff changeset
   978
        relH := (aRectangle height / winH) asFloat.
48194c26a46c Initial revision
claus
parents:
diff changeset
   979
        relX := (aRectangle left / winW) asFloat.
48194c26a46c Initial revision
claus
parents:
diff changeset
   980
        relY := (aRectangle top / winH) asFloat.
48194c26a46c Initial revision
claus
parents:
diff changeset
   981
        self origin:(relX @ relY) extent:(relW @ relH)
48194c26a46c Initial revision
claus
parents:
diff changeset
   982
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   983
"
48194c26a46c Initial revision
claus
parents:
diff changeset
   984
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   985
48194c26a46c Initial revision
claus
parents:
diff changeset
   986
viewRectangle
48194c26a46c Initial revision
claus
parents:
diff changeset
   987
    "return the inside area"
48194c26a46c Initial revision
claus
parents:
diff changeset
   988
48194c26a46c Initial revision
claus
parents:
diff changeset
   989
    |m2|
48194c26a46c Initial revision
claus
parents:
diff changeset
   990
48194c26a46c Initial revision
claus
parents:
diff changeset
   991
    innerClipRect notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
   992
        ^ innerClipRect
48194c26a46c Initial revision
claus
parents:
diff changeset
   993
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   994
    m2 := margin + margin.
48194c26a46c Initial revision
claus
parents:
diff changeset
   995
48194c26a46c Initial revision
claus
parents:
diff changeset
   996
    ^ (margin @ margin) extent:((width - m2) @ (height - m2))
48194c26a46c Initial revision
claus
parents:
diff changeset
   997
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   998
48194c26a46c Initial revision
claus
parents:
diff changeset
   999
viewOrigin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1000
    "return the viewOrigin; thats the coordinate of the contents 
48194c26a46c Initial revision
claus
parents:
diff changeset
  1001
     which is shown topLeft in the view 
48194c26a46c Initial revision
claus
parents:
diff changeset
  1002
     (i.e. the origin of the visible part of the contents)."
48194c26a46c Initial revision
claus
parents:
diff changeset
  1003
48194c26a46c Initial revision
claus
parents:
diff changeset
  1004
    ^ viewOrigin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1005
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1006
48194c26a46c Initial revision
claus
parents:
diff changeset
  1007
viewOrigin:aPoint
48194c26a46c Initial revision
claus
parents:
diff changeset
  1008
    "set the viewOrigin - i.e. virtually scroll without redrawing"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1009
48194c26a46c Initial revision
claus
parents:
diff changeset
  1010
    viewOrigin := aPoint
48194c26a46c Initial revision
claus
parents:
diff changeset
  1011
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1012
48194c26a46c Initial revision
claus
parents:
diff changeset
  1013
xOriginOfContents
48194c26a46c Initial revision
claus
parents:
diff changeset
  1014
    "return the x coordinate of the viewOrigin; used by scrollBars to compute
48194c26a46c Initial revision
claus
parents:
diff changeset
  1015
     thumb position"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1016
48194c26a46c Initial revision
claus
parents:
diff changeset
  1017
    ^ viewOrigin x
48194c26a46c Initial revision
claus
parents:
diff changeset
  1018
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1019
48194c26a46c Initial revision
claus
parents:
diff changeset
  1020
yOriginOfContents
48194c26a46c Initial revision
claus
parents:
diff changeset
  1021
    "return the y coordinate of the viewOrigin; used by scrollBars to compute
48194c26a46c Initial revision
claus
parents:
diff changeset
  1022
     thumb position"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1023
48194c26a46c Initial revision
claus
parents:
diff changeset
  1024
    ^ viewOrigin y
48194c26a46c Initial revision
claus
parents:
diff changeset
  1025
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1026
48194c26a46c Initial revision
claus
parents:
diff changeset
  1027
!View methodsFor:'accessing-hierarchy'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1028
48194c26a46c Initial revision
claus
parents:
diff changeset
  1029
superView
48194c26a46c Initial revision
claus
parents:
diff changeset
  1030
    "return my superView"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1031
48194c26a46c Initial revision
claus
parents:
diff changeset
  1032
    ^ superView
48194c26a46c Initial revision
claus
parents:
diff changeset
  1033
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1034
48194c26a46c Initial revision
claus
parents:
diff changeset
  1035
superView:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
  1036
    "set my superView to be aView"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1037
48194c26a46c Initial revision
claus
parents:
diff changeset
  1038
    superView := aView
48194c26a46c Initial revision
claus
parents:
diff changeset
  1039
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1040
48194c26a46c Initial revision
claus
parents:
diff changeset
  1041
topView
48194c26a46c Initial revision
claus
parents:
diff changeset
  1042
    "return the topView - thats the one with no superview"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1043
48194c26a46c Initial revision
claus
parents:
diff changeset
  1044
    |v|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1045
48194c26a46c Initial revision
claus
parents:
diff changeset
  1046
    v := self.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1047
    [v notNil] whileTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1048
        v superView isNil ifTrue:[^ v].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1049
        v := v superView
48194c26a46c Initial revision
claus
parents:
diff changeset
  1050
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1051
48194c26a46c Initial revision
claus
parents:
diff changeset
  1052
    ^ nil
48194c26a46c Initial revision
claus
parents:
diff changeset
  1053
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1054
48194c26a46c Initial revision
claus
parents:
diff changeset
  1055
subViews
48194c26a46c Initial revision
claus
parents:
diff changeset
  1056
    "return the collection of subviews"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1057
48194c26a46c Initial revision
claus
parents:
diff changeset
  1058
    ^ subViews
48194c26a46c Initial revision
claus
parents:
diff changeset
  1059
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1060
48194c26a46c Initial revision
claus
parents:
diff changeset
  1061
subViews:aListOfViews
48194c26a46c Initial revision
claus
parents:
diff changeset
  1062
    "set the collection of subviews"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1063
48194c26a46c Initial revision
claus
parents:
diff changeset
  1064
    subViews := aListOfViews.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1065
    subViews notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1066
        subViews do:[:view |
48194c26a46c Initial revision
claus
parents:
diff changeset
  1067
            view superView:self
48194c26a46c Initial revision
claus
parents:
diff changeset
  1068
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1069
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1070
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1071
48194c26a46c Initial revision
claus
parents:
diff changeset
  1072
!View methodsFor:'accessing-misc'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1073
48194c26a46c Initial revision
claus
parents:
diff changeset
  1074
viewGravity
48194c26a46c Initial revision
claus
parents:
diff changeset
  1075
    "return the viewGravity - thats the direction where the view will move
48194c26a46c Initial revision
claus
parents:
diff changeset
  1076
     when the superView is resized."
48194c26a46c Initial revision
claus
parents:
diff changeset
  1077
48194c26a46c Initial revision
claus
parents:
diff changeset
  1078
    ^ viewGravity
48194c26a46c Initial revision
claus
parents:
diff changeset
  1079
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1080
48194c26a46c Initial revision
claus
parents:
diff changeset
  1081
viewGravity:gravity
48194c26a46c Initial revision
claus
parents:
diff changeset
  1082
    "set the viewGravity - thats the direction where the view will move
48194c26a46c Initial revision
claus
parents:
diff changeset
  1083
     when the superView is resized."
48194c26a46c Initial revision
claus
parents:
diff changeset
  1084
48194c26a46c Initial revision
claus
parents:
diff changeset
  1085
    viewGravity := gravity
48194c26a46c Initial revision
claus
parents:
diff changeset
  1086
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1087
48194c26a46c Initial revision
claus
parents:
diff changeset
  1088
bitGravity
48194c26a46c Initial revision
claus
parents:
diff changeset
  1089
    "return the bitGravity - thats the direction where the contents will move
48194c26a46c Initial revision
claus
parents:
diff changeset
  1090
     when the the view is resized."
48194c26a46c Initial revision
claus
parents:
diff changeset
  1091
48194c26a46c Initial revision
claus
parents:
diff changeset
  1092
    ^ bitGravity
48194c26a46c Initial revision
claus
parents:
diff changeset
  1093
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1094
48194c26a46c Initial revision
claus
parents:
diff changeset
  1095
inputOnly
48194c26a46c Initial revision
claus
parents:
diff changeset
  1096
    "return true, if this view is an input-only view;
48194c26a46c Initial revision
claus
parents:
diff changeset
  1097
     input only views are transparent and can be layed on top of a view to
48194c26a46c Initial revision
claus
parents:
diff changeset
  1098
     catch its input"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1099
48194c26a46c Initial revision
claus
parents:
diff changeset
  1100
    ^ false
48194c26a46c Initial revision
claus
parents:
diff changeset
  1101
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1102
48194c26a46c Initial revision
claus
parents:
diff changeset
  1103
createOnTop
48194c26a46c Initial revision
claus
parents:
diff changeset
  1104
    "return true, if this view should be put on top (raised) automatically.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1105
     usually this is true for alertBoxes etc."
48194c26a46c Initial revision
claus
parents:
diff changeset
  1106
48194c26a46c Initial revision
claus
parents:
diff changeset
  1107
    ^ false
48194c26a46c Initial revision
claus
parents:
diff changeset
  1108
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1109
48194c26a46c Initial revision
claus
parents:
diff changeset
  1110
canDrop:anObjectOrCollection
48194c26a46c Initial revision
claus
parents:
diff changeset
  1111
    "return true, if anObjectOrCollection can be
48194c26a46c Initial revision
claus
parents:
diff changeset
  1112
     dropped in the receiver. This method should be
48194c26a46c Initial revision
claus
parents:
diff changeset
  1113
     redefined in views which can take objects"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1114
48194c26a46c Initial revision
claus
parents:
diff changeset
  1115
    ^ false
48194c26a46c Initial revision
claus
parents:
diff changeset
  1116
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1117
48194c26a46c Initial revision
claus
parents:
diff changeset
  1118
is3D
48194c26a46c Initial revision
claus
parents:
diff changeset
  1119
    ^ #(next iris openwin view3D motif) includes:style
48194c26a46c Initial revision
claus
parents:
diff changeset
  1120
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1121
48194c26a46c Initial revision
claus
parents:
diff changeset
  1122
shown
48194c26a46c Initial revision
claus
parents:
diff changeset
  1123
    "return true if the view is shown; false if hidden"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1124
48194c26a46c Initial revision
claus
parents:
diff changeset
  1125
    ^ shown
48194c26a46c Initial revision
claus
parents:
diff changeset
  1126
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1127
48194c26a46c Initial revision
claus
parents:
diff changeset
  1128
isCollapsed
48194c26a46c Initial revision
claus
parents:
diff changeset
  1129
    ^ shown not
48194c26a46c Initial revision
claus
parents:
diff changeset
  1130
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1131
48194c26a46c Initial revision
claus
parents:
diff changeset
  1132
hidden:aBoolean
48194c26a46c Initial revision
claus
parents:
diff changeset
  1133
    "if the argument is true, the receiver view will not
48194c26a46c Initial revision
claus
parents:
diff changeset
  1134
     be realized automatically when superview is realized"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1135
48194c26a46c Initial revision
claus
parents:
diff changeset
  1136
    hidden := aBoolean
48194c26a46c Initial revision
claus
parents:
diff changeset
  1137
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1138
48194c26a46c Initial revision
claus
parents:
diff changeset
  1139
hidden
48194c26a46c Initial revision
claus
parents:
diff changeset
  1140
    "return true, if the view does not want to be realized
48194c26a46c Initial revision
claus
parents:
diff changeset
  1141
     automatically when superview is realized"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1142
48194c26a46c Initial revision
claus
parents:
diff changeset
  1143
    ^ hidden
48194c26a46c Initial revision
claus
parents:
diff changeset
  1144
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1145
48194c26a46c Initial revision
claus
parents:
diff changeset
  1146
lower
48194c26a46c Initial revision
claus
parents:
diff changeset
  1147
    "bring to back"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1148
48194c26a46c Initial revision
claus
parents:
diff changeset
  1149
    drawableId isNil ifTrue:[self create].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1150
    device lowerWindow:drawableId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1151
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1152
48194c26a46c Initial revision
claus
parents:
diff changeset
  1153
raise
48194c26a46c Initial revision
claus
parents:
diff changeset
  1154
    "bring to front"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1155
48194c26a46c Initial revision
claus
parents:
diff changeset
  1156
    drawableId isNil ifTrue:[self create].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1157
    device raiseWindow:drawableId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1158
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1159
48194c26a46c Initial revision
claus
parents:
diff changeset
  1160
!View methodsFor:'accessing-bg & border'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1161
48194c26a46c Initial revision
claus
parents:
diff changeset
  1162
viewBackground:something
48194c26a46c Initial revision
claus
parents:
diff changeset
  1163
    "set the viewBackground to something, a color, pixel or form.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1164
     if its a color and we run on a color display, also set shadow and light
48194c26a46c Initial revision
claus
parents:
diff changeset
  1165
     colors."
48194c26a46c Initial revision
claus
parents:
diff changeset
  1166
48194c26a46c Initial revision
claus
parents:
diff changeset
  1167
    (something isKindOf:Color) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1168
        (device hasColors or:[device hasGreyscales]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1169
            shadowColor := something darkened.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1170
            lightColor := something lightened
48194c26a46c Initial revision
claus
parents:
diff changeset
  1171
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1172
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1173
    super viewBackground:something
48194c26a46c Initial revision
claus
parents:
diff changeset
  1174
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1175
48194c26a46c Initial revision
claus
parents:
diff changeset
  1176
borderColor
48194c26a46c Initial revision
claus
parents:
diff changeset
  1177
    "return my borderColor"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1178
48194c26a46c Initial revision
claus
parents:
diff changeset
  1179
    ^ borderColor
48194c26a46c Initial revision
claus
parents:
diff changeset
  1180
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1181
48194c26a46c Initial revision
claus
parents:
diff changeset
  1182
borderColor:aColor
48194c26a46c Initial revision
claus
parents:
diff changeset
  1183
    "set my borderColor"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1184
48194c26a46c Initial revision
claus
parents:
diff changeset
  1185
    |id dither|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1186
48194c26a46c Initial revision
claus
parents:
diff changeset
  1187
    (aColor ~~ borderColor) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1188
        borderColor := aColor.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1189
        drawableId notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1190
            borderColor := borderColor on:device.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1191
            id := borderColor colorId.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1192
            id notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1193
                device setWindowBorderColor:id in:drawableId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1194
            ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1195
                dither := borderColor ditherForm.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1196
                dither notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1197
                    device setWindowBorderPixmap:(dither id) in:drawableId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1198
                ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1199
                    'bad borderColor' printNewline
48194c26a46c Initial revision
claus
parents:
diff changeset
  1200
                ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1201
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1202
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1203
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1204
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1205
48194c26a46c Initial revision
claus
parents:
diff changeset
  1206
borderWidth
48194c26a46c Initial revision
claus
parents:
diff changeset
  1207
    "return my borderWidth"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1208
48194c26a46c Initial revision
claus
parents:
diff changeset
  1209
    ^ borderWidth
48194c26a46c Initial revision
claus
parents:
diff changeset
  1210
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1211
48194c26a46c Initial revision
claus
parents:
diff changeset
  1212
borderWidth:aNumber
48194c26a46c Initial revision
claus
parents:
diff changeset
  1213
    "set my borderWidth"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1214
48194c26a46c Initial revision
claus
parents:
diff changeset
  1215
    (aNumber ~~ borderWidth) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1216
        borderWidth := aNumber.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1217
        drawableId notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1218
            device setWindowBorderWidth:aNumber in:drawableId
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
48194c26a46c Initial revision
claus
parents:
diff changeset
  1223
borderShape:aForm
48194c26a46c Initial revision
claus
parents:
diff changeset
  1224
    "set the borderShape to aForm"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1225
48194c26a46c Initial revision
claus
parents:
diff changeset
  1226
    borderShape := aForm.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1227
    drawableId notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1228
        device setWindowBorderShape:(aForm id) in:drawableId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1229
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1230
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1231
48194c26a46c Initial revision
claus
parents:
diff changeset
  1232
viewShape:aForm
48194c26a46c Initial revision
claus
parents:
diff changeset
  1233
    "set the viewShape to aForm"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1234
48194c26a46c Initial revision
claus
parents:
diff changeset
  1235
    viewShape := aForm.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1236
    drawableId notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1237
        device setWindowShape:(aForm id) in:drawableId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1238
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1239
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1240
48194c26a46c Initial revision
claus
parents:
diff changeset
  1241
name
48194c26a46c Initial revision
claus
parents:
diff changeset
  1242
    "return my name component to be used for resource-access"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1243
48194c26a46c Initial revision
claus
parents:
diff changeset
  1244
    ^ name
48194c26a46c Initial revision
claus
parents:
diff changeset
  1245
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1246
48194c26a46c Initial revision
claus
parents:
diff changeset
  1247
fullName
48194c26a46c Initial revision
claus
parents:
diff changeset
  1248
    "return my full name to be used for resource-access"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1249
48194c26a46c Initial revision
claus
parents:
diff changeset
  1250
    superView notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1251
        ^ superView fullName , '.' , name
48194c26a46c Initial revision
claus
parents:
diff changeset
  1252
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1253
    ^ name
48194c26a46c Initial revision
claus
parents:
diff changeset
  1254
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1255
48194c26a46c Initial revision
claus
parents:
diff changeset
  1256
name:aString
48194c26a46c Initial revision
claus
parents:
diff changeset
  1257
    "set my name component to be used for resource-access"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1258
48194c26a46c Initial revision
claus
parents:
diff changeset
  1259
    name := aString
48194c26a46c Initial revision
claus
parents:
diff changeset
  1260
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1261
48194c26a46c Initial revision
claus
parents:
diff changeset
  1262
keyboardHandler:someOne
48194c26a46c Initial revision
claus
parents:
diff changeset
  1263
    "set my keyboardHandler"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1264
48194c26a46c Initial revision
claus
parents:
diff changeset
  1265
    keyboardHandler := someOne
48194c26a46c Initial revision
claus
parents:
diff changeset
  1266
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1267
48194c26a46c Initial revision
claus
parents:
diff changeset
  1268
level
48194c26a46c Initial revision
claus
parents:
diff changeset
  1269
    "return my level relative to superView (3D)"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1270
48194c26a46c Initial revision
claus
parents:
diff changeset
  1271
    ^ level
48194c26a46c Initial revision
claus
parents:
diff changeset
  1272
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1273
48194c26a46c Initial revision
claus
parents:
diff changeset
  1274
level:aNumber
48194c26a46c Initial revision
claus
parents:
diff changeset
  1275
    "set my level relative to superView (3D)"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1276
48194c26a46c Initial revision
claus
parents:
diff changeset
  1277
    |oldMargin how|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1278
48194c26a46c Initial revision
claus
parents:
diff changeset
  1279
    self is3D ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1280
        (aNumber ~~ level) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1281
            level := aNumber.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1282
            oldMargin := margin.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1283
            margin := level abs.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1284
48194c26a46c Initial revision
claus
parents:
diff changeset
  1285
            realized ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1286
                (margin > oldMargin) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1287
                    how := #smaller
48194c26a46c Initial revision
claus
parents:
diff changeset
  1288
                ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1289
                    how := #larger
48194c26a46c Initial revision
claus
parents:
diff changeset
  1290
                ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1291
                controller notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1292
                    controller sizeChanged:how of:self
48194c26a46c Initial revision
claus
parents:
diff changeset
  1293
                ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1294
                    self sizeChanged:how
48194c26a46c Initial revision
claus
parents:
diff changeset
  1295
                ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1296
                self computeInnerClip.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1297
                self redrawEdges
48194c26a46c Initial revision
claus
parents:
diff changeset
  1298
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1299
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1300
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1301
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1302
48194c26a46c Initial revision
claus
parents:
diff changeset
  1303
margin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1304
    "return my margin - this is usually the level,
48194c26a46c Initial revision
claus
parents:
diff changeset
  1305
     but can be more for some views"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1306
48194c26a46c Initial revision
claus
parents:
diff changeset
  1307
    ^ margin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1308
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1309
48194c26a46c Initial revision
claus
parents:
diff changeset
  1310
widthIncludingBorder
48194c26a46c Initial revision
claus
parents:
diff changeset
  1311
    "return my width including border"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1312
48194c26a46c Initial revision
claus
parents:
diff changeset
  1313
    ^ width + (2*borderWidth)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1314
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1315
48194c26a46c Initial revision
claus
parents:
diff changeset
  1316
heightIncludingBorder
48194c26a46c Initial revision
claus
parents:
diff changeset
  1317
    "return my height including border"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1318
48194c26a46c Initial revision
claus
parents:
diff changeset
  1319
    ^ height + (2*borderWidth)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1320
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1321
48194c26a46c Initial revision
claus
parents:
diff changeset
  1322
!View methodsFor:'adding & removing components'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1323
48194c26a46c Initial revision
claus
parents:
diff changeset
  1324
addComponent:aComponent
48194c26a46c Initial revision
claus
parents:
diff changeset
  1325
    components isNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1326
        components := IdentitySet new
48194c26a46c Initial revision
claus
parents:
diff changeset
  1327
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1328
    components add:aComponent
48194c26a46c Initial revision
claus
parents:
diff changeset
  1329
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1330
48194c26a46c Initial revision
claus
parents:
diff changeset
  1331
removeComponent:aComponent
48194c26a46c Initial revision
claus
parents:
diff changeset
  1332
    components isNil ifTrue:[^self].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1333
    components remove:aComponent ifAbsent:[]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1334
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1335
48194c26a46c Initial revision
claus
parents:
diff changeset
  1336
addSubView:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
  1337
    "add a view to the collection of subviews"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1338
48194c26a46c Initial revision
claus
parents:
diff changeset
  1339
    subViews isNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1340
        subViews := OrderedCollection new
48194c26a46c Initial revision
claus
parents:
diff changeset
  1341
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1342
    subViews add:aView.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1343
    aView superView:self.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1344
    (aView device ~~ device) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1345
        'warning subview (' print. aView class name print.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1346
        ') has different device than me (' print.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1347
        self class name print. ').' printNewline.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1348
        aView device:device
48194c26a46c Initial revision
claus
parents:
diff changeset
  1349
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1350
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1351
48194c26a46c Initial revision
claus
parents:
diff changeset
  1352
addSubView:aView in:bounds borderWidth:bw
48194c26a46c Initial revision
claus
parents:
diff changeset
  1353
    aView borderWidth:bw.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1354
    aView origin:(bounds origin x asFloat) @ (bounds origin y asFloat)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1355
          extent:(bounds extent x asFloat) @ (bounds extent y asFloat).
48194c26a46c Initial revision
claus
parents:
diff changeset
  1356
    self addSubView:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
  1357
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1358
48194c26a46c Initial revision
claus
parents:
diff changeset
  1359
add:aView in:bounds
48194c26a46c Initial revision
claus
parents:
diff changeset
  1360
    aView origin:(bounds origin x asFloat) @ (bounds origin y asFloat)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1361
          extent:(bounds extent x asFloat) @ (bounds extent y asFloat).
48194c26a46c Initial revision
claus
parents:
diff changeset
  1362
    self addSubView:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
  1363
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1364
48194c26a46c Initial revision
claus
parents:
diff changeset
  1365
addSubView:aView viewport:aRectangle
48194c26a46c Initial revision
claus
parents:
diff changeset
  1366
    "Adds aView to the views list of subviews and uses the
48194c26a46c Initial revision
claus
parents:
diff changeset
  1367
     existing subviews window and the new viewport to position it"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1368
48194c26a46c Initial revision
claus
parents:
diff changeset
  1369
    self addSubView:aView.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1370
    aView viewport:aRectangle
48194c26a46c Initial revision
claus
parents:
diff changeset
  1371
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1372
48194c26a46c Initial revision
claus
parents:
diff changeset
  1373
addSubView:aView window:aWindowRectangle viewport:aViewportRectangle
48194c26a46c Initial revision
claus
parents:
diff changeset
  1374
    "Adds aView to the views list of subviews and uses 
48194c26a46c Initial revision
claus
parents:
diff changeset
  1375
     aWindowRectangle and aViewportRectangle to position it"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1376
48194c26a46c Initial revision
claus
parents:
diff changeset
  1377
    self addSubView:aView.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1378
    aView window:aWindowRectangle.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1379
    aView viewport:aViewportRectangle
48194c26a46c Initial revision
claus
parents:
diff changeset
  1380
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1381
48194c26a46c Initial revision
claus
parents:
diff changeset
  1382
removeSubView:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
  1383
    "remove a view from the collection of subviews"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1384
48194c26a46c Initial revision
claus
parents:
diff changeset
  1385
    subViews remove:aView ifAbsent:[nil].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1386
    (subViews size == 0) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1387
        subViews := nil
48194c26a46c Initial revision
claus
parents:
diff changeset
  1388
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1389
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1390
48194c26a46c Initial revision
claus
parents:
diff changeset
  1391
!View methodsFor:'ST-80 compatibility'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1392
48194c26a46c Initial revision
claus
parents:
diff changeset
  1393
on:aModel aspect:aspect change:change list:list menu:menu
48194c26a46c Initial revision
claus
parents:
diff changeset
  1394
    "ST-80 compatibility"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1395
48194c26a46c Initial revision
claus
parents:
diff changeset
  1396
    aspectSymbol := aspect.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1397
    changeSymbol := change.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1398
    menuSymbol := menu.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1399
    self model:aModel
48194c26a46c Initial revision
claus
parents:
diff changeset
  1400
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1401
48194c26a46c Initial revision
claus
parents:
diff changeset
  1402
sensor
48194c26a46c Initial revision
claus
parents:
diff changeset
  1403
    "in this smalltalk, all sensor messages are simulated by the display-device"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1404
48194c26a46c Initial revision
claus
parents:
diff changeset
  1405
    ^ device
48194c26a46c Initial revision
claus
parents:
diff changeset
  1406
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1407
48194c26a46c Initial revision
claus
parents:
diff changeset
  1408
open
48194c26a46c Initial revision
claus
parents:
diff changeset
  1409
    ^ self realize
48194c26a46c Initial revision
claus
parents:
diff changeset
  1410
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1411
48194c26a46c Initial revision
claus
parents:
diff changeset
  1412
update
48194c26a46c Initial revision
claus
parents:
diff changeset
  1413
    ^ self redraw
48194c26a46c Initial revision
claus
parents:
diff changeset
  1414
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1415
48194c26a46c Initial revision
claus
parents:
diff changeset
  1416
update:aspect
48194c26a46c Initial revision
claus
parents:
diff changeset
  1417
    "an update request - should be redefined in subclasses"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1418
48194c26a46c Initial revision
claus
parents:
diff changeset
  1419
    ^ self update
48194c26a46c Initial revision
claus
parents:
diff changeset
  1420
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1421
48194c26a46c Initial revision
claus
parents:
diff changeset
  1422
update:aspect with:anObject
48194c26a46c Initial revision
claus
parents:
diff changeset
  1423
    "an update request - should be redefined in subclasses"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1424
48194c26a46c Initial revision
claus
parents:
diff changeset
  1425
    aspect == #rectangle ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1426
        ^ self update:#all
48194c26a46c Initial revision
claus
parents:
diff changeset
  1427
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1428
    ^ self update:aspect
48194c26a46c Initial revision
claus
parents:
diff changeset
  1429
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1430
48194c26a46c Initial revision
claus
parents:
diff changeset
  1431
!View methodsFor:'informing others of changes'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1432
48194c26a46c Initial revision
claus
parents:
diff changeset
  1433
originWillChange
48194c26a46c Initial revision
claus
parents:
diff changeset
  1434
    "this one is sent, just before viewOrigin changes -
48194c26a46c Initial revision
claus
parents:
diff changeset
  1435
     gives subclasses a chance to catch scrolls easily
48194c26a46c Initial revision
claus
parents:
diff changeset
  1436
     (for example to hide cursor before scroll)"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1437
48194c26a46c Initial revision
claus
parents:
diff changeset
  1438
    ^ self
48194c26a46c Initial revision
claus
parents:
diff changeset
  1439
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1440
48194c26a46c Initial revision
claus
parents:
diff changeset
  1441
originChangeAction:aBlock
48194c26a46c Initial revision
claus
parents:
diff changeset
  1442
    "set the action, aBlock to be evaluated whenever my orgin changes
48194c26a46c Initial revision
claus
parents:
diff changeset
  1443
     - to allow for scrollBars to track contents"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1444
48194c26a46c Initial revision
claus
parents:
diff changeset
  1445
    originChangeAction := aBlock
48194c26a46c Initial revision
claus
parents:
diff changeset
  1446
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1447
48194c26a46c Initial revision
claus
parents:
diff changeset
  1448
originChanged:delta
48194c26a46c Initial revision
claus
parents:
diff changeset
  1449
    "this one is sent, after my origin changed -
48194c26a46c Initial revision
claus
parents:
diff changeset
  1450
     (for example to redraw cursor)"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1451
48194c26a46c Initial revision
claus
parents:
diff changeset
  1452
    originChangeAction notNil ifTrue:[originChangeAction value:self]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1453
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1454
48194c26a46c Initial revision
claus
parents:
diff changeset
  1455
contentsChangeAction:aBlock
48194c26a46c Initial revision
claus
parents:
diff changeset
  1456
    "set the action, aBlock to be evaluated whenever my contents changes
48194c26a46c Initial revision
claus
parents:
diff changeset
  1457
     - to allow for scrollBars to track contents"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1458
48194c26a46c Initial revision
claus
parents:
diff changeset
  1459
    contentsChangeAction := aBlock
48194c26a46c Initial revision
claus
parents:
diff changeset
  1460
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1461
48194c26a46c Initial revision
claus
parents:
diff changeset
  1462
contentsChanged
48194c26a46c Initial revision
claus
parents:
diff changeset
  1463
    "this one is sent, whenever contents changes size -
48194c26a46c Initial revision
claus
parents:
diff changeset
  1464
     gives subclasses a chance to catch it (i.e. scrollbars etc)"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1465
48194c26a46c Initial revision
claus
parents:
diff changeset
  1466
    contentsChangeAction notNil ifTrue:[contentsChangeAction value:self]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1467
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1468
48194c26a46c Initial revision
claus
parents:
diff changeset
  1469
!View methodsFor:'scrolling'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1470
48194c26a46c Initial revision
claus
parents:
diff changeset
  1471
widthForScrollBetween:firstLine and:lastLine
48194c26a46c Initial revision
claus
parents:
diff changeset
  1472
    "answer the width in pixels for a scroll between firstLine and lastLine
48194c26a46c Initial revision
claus
parents:
diff changeset
  1473
     - return full width here since we do not know how wide contents is"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1474
48194c26a46c Initial revision
claus
parents:
diff changeset
  1475
    ^ (width - margin - margin)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1476
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1477
48194c26a46c Initial revision
claus
parents:
diff changeset
  1478
scrollVerticalToPercent:percent
48194c26a46c Initial revision
claus
parents:
diff changeset
  1479
    "scroll to a position given in percent of total"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1480
48194c26a46c Initial revision
claus
parents:
diff changeset
  1481
    self scrollVerticalTo:
48194c26a46c Initial revision
claus
parents:
diff changeset
  1482
            ((((self heightOfContents * percent) / 100.0) + 0.5) asInteger)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1483
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1484
48194c26a46c Initial revision
claus
parents:
diff changeset
  1485
scrollVerticalTo:aPixelOffset
48194c26a46c Initial revision
claus
parents:
diff changeset
  1486
    "change origin to make aPixelOffset be the top line"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1487
48194c26a46c Initial revision
claus
parents:
diff changeset
  1488
    |orgY|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1489
48194c26a46c Initial revision
claus
parents:
diff changeset
  1490
    orgY := viewOrigin y.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1491
48194c26a46c Initial revision
claus
parents:
diff changeset
  1492
    (aPixelOffset < orgY) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1493
        self scrollUp:(orgY - aPixelOffset)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1494
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1495
        (aPixelOffset > orgY) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1496
            self scrollDown:(aPixelOffset - orgY)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1497
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1498
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1499
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1500
48194c26a46c Initial revision
claus
parents:
diff changeset
  1501
scrollHorizontalToPercent:percent
48194c26a46c Initial revision
claus
parents:
diff changeset
  1502
    "scroll to a position given in percent of total"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1503
48194c26a46c Initial revision
claus
parents:
diff changeset
  1504
    self scrollHorizontalTo:
48194c26a46c Initial revision
claus
parents:
diff changeset
  1505
            ((((self widthOfContents * percent) / 100.0) + 0.5) asInteger)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1506
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1507
48194c26a46c Initial revision
claus
parents:
diff changeset
  1508
scrollHorizontalTo:aPixelOffset
48194c26a46c Initial revision
claus
parents:
diff changeset
  1509
    "change origin to make aPixelOffset be the left col"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1510
48194c26a46c Initial revision
claus
parents:
diff changeset
  1511
    |orgX|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1512
48194c26a46c Initial revision
claus
parents:
diff changeset
  1513
    orgX := viewOrigin x.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1514
48194c26a46c Initial revision
claus
parents:
diff changeset
  1515
    (aPixelOffset < orgX) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1516
        self scrollLeft:(orgX - aPixelOffset)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1517
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1518
        (aPixelOffset > orgX) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1519
            self scrollRight:(aPixelOffset - orgX)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1520
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1521
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1522
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1523
48194c26a46c Initial revision
claus
parents:
diff changeset
  1524
scrollTo:aPixelOffset
48194c26a46c Initial revision
claus
parents:
diff changeset
  1525
    "only here for historic reasons - will vanish soon"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1526
48194c26a46c Initial revision
claus
parents:
diff changeset
  1527
    ^ self scrollVerticalTo:aPixelOffset
48194c26a46c Initial revision
claus
parents:
diff changeset
  1528
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1529
48194c26a46c Initial revision
claus
parents:
diff changeset
  1530
scrollToTop
48194c26a46c Initial revision
claus
parents:
diff changeset
  1531
    "move viewOrigin to top"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1532
48194c26a46c Initial revision
claus
parents:
diff changeset
  1533
    self scrollVerticalTo:0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1534
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1535
48194c26a46c Initial revision
claus
parents:
diff changeset
  1536
scrollUp:nPixels
48194c26a46c Initial revision
claus
parents:
diff changeset
  1537
    "change origin to scroll up some pixels"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1538
48194c26a46c Initial revision
claus
parents:
diff changeset
  1539
    |count "{ Class:SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1540
     m2    "{ Class:SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1541
     w     "{ Class:SmallInteger }"|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1542
48194c26a46c Initial revision
claus
parents:
diff changeset
  1543
    count := nPixels.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1544
    (count > viewOrigin y) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1545
        count := viewOrigin y
48194c26a46c Initial revision
claus
parents:
diff changeset
  1546
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1547
    (count <= 0) ifTrue:[^ self].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1548
48194c26a46c Initial revision
claus
parents:
diff changeset
  1549
    self originWillChange.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1550
    viewOrigin := viewOrigin x @ (viewOrigin y - count).
48194c26a46c Initial revision
claus
parents:
diff changeset
  1551
48194c26a46c Initial revision
claus
parents:
diff changeset
  1552
    (count >= self innerHeight) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1553
        self redraw.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1554
        self originChanged:(0 @ count negated)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1555
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1556
        w := self widthForScrollBetween:(viewOrigin y)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1557
                                    and:(viewOrigin y + count).
48194c26a46c Initial revision
claus
parents:
diff changeset
  1558
        m2 := margin * 2.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1559
        w := w min:(width - m2).
48194c26a46c Initial revision
claus
parents:
diff changeset
  1560
48194c26a46c Initial revision
claus
parents:
diff changeset
  1561
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1562
        super function:#copy.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1563
        super foreground:White.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1564
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1565
        self copyFrom:self x:margin y:margin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1566
                         toX:margin y:(count + margin)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1567
                       width:w 
48194c26a46c Initial revision
claus
parents:
diff changeset
  1568
                      height:(height - m2 - count).
48194c26a46c Initial revision
claus
parents:
diff changeset
  1569
        self redrawX:margin y:margin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1570
               width:(width - m2)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1571
              height:count.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1572
48194c26a46c Initial revision
claus
parents:
diff changeset
  1573
        self originChanged:(0 @ count negated).
48194c26a46c Initial revision
claus
parents:
diff changeset
  1574
        self waitForExpose
48194c26a46c Initial revision
claus
parents:
diff changeset
  1575
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1576
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1577
48194c26a46c Initial revision
claus
parents:
diff changeset
  1578
scrollUp
48194c26a46c Initial revision
claus
parents:
diff changeset
  1579
    "scroll up by some amount
48194c26a46c Initial revision
claus
parents:
diff changeset
  1580
      - question is how much is a good default here"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1581
48194c26a46c Initial revision
claus
parents:
diff changeset
  1582
    self scrollUp:(device verticalPixelPerMillimeter * 20) asInteger
48194c26a46c Initial revision
claus
parents:
diff changeset
  1583
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1584
48194c26a46c Initial revision
claus
parents:
diff changeset
  1585
scrollDown:nPixels
48194c26a46c Initial revision
claus
parents:
diff changeset
  1586
    "change origin to scroll down some pixels"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1587
48194c26a46c Initial revision
claus
parents:
diff changeset
  1588
    |count "{ Class:SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1589
     m2    "{ Class:SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1590
     w     "{ Class:SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1591
     hCont "{ Class:SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1592
     ih    "{ Class:SmallInteger }"|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1593
48194c26a46c Initial revision
claus
parents:
diff changeset
  1594
    count := nPixels.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1595
    hCont := self heightOfContents.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1596
    ih := self innerHeight.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1597
48194c26a46c Initial revision
claus
parents:
diff changeset
  1598
    ((viewOrigin y + nPixels + ih) > hCont) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1599
        count := hCont - viewOrigin y - ih
48194c26a46c Initial revision
claus
parents:
diff changeset
  1600
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1601
    (count <= 0) ifTrue:[^ self].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1602
48194c26a46c Initial revision
claus
parents:
diff changeset
  1603
    self originWillChange.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1604
    viewOrigin := viewOrigin x @ (viewOrigin y + count).
48194c26a46c Initial revision
claus
parents:
diff changeset
  1605
48194c26a46c Initial revision
claus
parents:
diff changeset
  1606
    (count >= ih) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1607
        self redraw.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1608
        self originChanged:(0 @ count)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1609
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1610
        m2 := margin * 2.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1611
        w := self widthForScrollBetween:(viewOrigin y)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1612
                                    and:(viewOrigin y + count).
48194c26a46c Initial revision
claus
parents:
diff changeset
  1613
        w := w min:(width - m2).
48194c26a46c Initial revision
claus
parents:
diff changeset
  1614
48194c26a46c Initial revision
claus
parents:
diff changeset
  1615
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1616
        super function:#copy.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1617
        super foreground:White.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1618
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1619
        self copyFrom:self x:margin y:(count + margin)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1620
                         toX:margin y:margin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1621
                       width:w 
48194c26a46c Initial revision
claus
parents:
diff changeset
  1622
                      height:(height - m2 - count).
48194c26a46c Initial revision
claus
parents:
diff changeset
  1623
48194c26a46c Initial revision
claus
parents:
diff changeset
  1624
        self redrawX:margin y:(height - margin - count) 
48194c26a46c Initial revision
claus
parents:
diff changeset
  1625
               width:(width - m2) height:count.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1626
48194c26a46c Initial revision
claus
parents:
diff changeset
  1627
        self originChanged:(0 @ count).
48194c26a46c Initial revision
claus
parents:
diff changeset
  1628
        self waitForExpose
48194c26a46c Initial revision
claus
parents:
diff changeset
  1629
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1630
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1631
48194c26a46c Initial revision
claus
parents:
diff changeset
  1632
scrollDown
48194c26a46c Initial revision
claus
parents:
diff changeset
  1633
    "scroll down by some amount
48194c26a46c Initial revision
claus
parents:
diff changeset
  1634
      - question is how much is a good default here"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1635
48194c26a46c Initial revision
claus
parents:
diff changeset
  1636
    self scrollDown:(device verticalPixelPerMillimeter * 20) asInteger
48194c26a46c Initial revision
claus
parents:
diff changeset
  1637
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1638
48194c26a46c Initial revision
claus
parents:
diff changeset
  1639
scrollLeft:nPixels
48194c26a46c Initial revision
claus
parents:
diff changeset
  1640
    "change origin to scroll left some pixels"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1641
48194c26a46c Initial revision
claus
parents:
diff changeset
  1642
    |count "{ Class:SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1643
     m2    "{ Class:SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1644
     h     "{ Class:SmallInteger }"|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1645
48194c26a46c Initial revision
claus
parents:
diff changeset
  1646
    count := nPixels.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1647
    (count > viewOrigin x) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1648
        count := viewOrigin x
48194c26a46c Initial revision
claus
parents:
diff changeset
  1649
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1650
    (count <= 0) ifTrue:[^ self].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1651
48194c26a46c Initial revision
claus
parents:
diff changeset
  1652
    self originWillChange.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1653
    viewOrigin := (viewOrigin x - count) @ viewOrigin y.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1654
48194c26a46c Initial revision
claus
parents:
diff changeset
  1655
    (count >= self innerWidth) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1656
        self redraw.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1657
        self originChanged:(count negated @ 0)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1658
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1659
        m2 := margin * 2.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1660
        h := (height - m2).
48194c26a46c Initial revision
claus
parents:
diff changeset
  1661
48194c26a46c Initial revision
claus
parents:
diff changeset
  1662
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1663
        super function:#copy.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1664
        super foreground:White.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1665
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1666
        self copyFrom:self x:margin y:margin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1667
                         toX:(count + margin) y:margin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1668
                       width:(width - m2 - count) 
48194c26a46c Initial revision
claus
parents:
diff changeset
  1669
                      height:h.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1670
48194c26a46c Initial revision
claus
parents:
diff changeset
  1671
        self redrawX:margin y:margin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1672
               width:count
48194c26a46c Initial revision
claus
parents:
diff changeset
  1673
              height:(height - m2).
48194c26a46c Initial revision
claus
parents:
diff changeset
  1674
48194c26a46c Initial revision
claus
parents:
diff changeset
  1675
        self originChanged:(count negated @ 0).
48194c26a46c Initial revision
claus
parents:
diff changeset
  1676
        self waitForExpose
48194c26a46c Initial revision
claus
parents:
diff changeset
  1677
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1678
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1679
48194c26a46c Initial revision
claus
parents:
diff changeset
  1680
scrollLeft
48194c26a46c Initial revision
claus
parents:
diff changeset
  1681
    "scroll left by some amount
48194c26a46c Initial revision
claus
parents:
diff changeset
  1682
      - question is how much is a good default here"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1683
48194c26a46c Initial revision
claus
parents:
diff changeset
  1684
    self scrollLeft:(device horizontalPixelPerMillimeter * 20) asInteger
48194c26a46c Initial revision
claus
parents:
diff changeset
  1685
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1686
48194c26a46c Initial revision
claus
parents:
diff changeset
  1687
scrollRight:nPixels
48194c26a46c Initial revision
claus
parents:
diff changeset
  1688
    "change origin to scroll right some pixels"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1689
48194c26a46c Initial revision
claus
parents:
diff changeset
  1690
    |count "{ Class:SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1691
     m2    "{ Class:SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1692
     h     "{ Class:SmallInteger }" 
48194c26a46c Initial revision
claus
parents:
diff changeset
  1693
     wCont "{ Class:SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1694
     iw    "{ Class:SmallInteger }"|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1695
48194c26a46c Initial revision
claus
parents:
diff changeset
  1696
    count := nPixels.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1697
    wCont := self widthOfContents.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1698
    iw := self innerWidth.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1699
48194c26a46c Initial revision
claus
parents:
diff changeset
  1700
    ((viewOrigin x + nPixels + iw) > wCont) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1701
        count := wCont - viewOrigin x - iw
48194c26a46c Initial revision
claus
parents:
diff changeset
  1702
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1703
    (count <= 0) ifTrue:[^ self].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1704
48194c26a46c Initial revision
claus
parents:
diff changeset
  1705
    self originWillChange.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1706
    viewOrigin := (viewOrigin x + count) @ viewOrigin y.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1707
48194c26a46c Initial revision
claus
parents:
diff changeset
  1708
    (count >= iw) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1709
        self redraw.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1710
        self originChanged:(count @ 0)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1711
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1712
        m2 := margin * 2.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1713
        h := (height - m2).
48194c26a46c Initial revision
claus
parents:
diff changeset
  1714
48194c26a46c Initial revision
claus
parents:
diff changeset
  1715
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1716
        super function:#copy.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1717
        super foreground:White.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1718
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1719
        self copyFrom:self x:(count + margin) y:margin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1720
                         toX:margin y:margin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1721
                       width:(width - m2 - count) 
48194c26a46c Initial revision
claus
parents:
diff changeset
  1722
                      height:h.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1723
48194c26a46c Initial revision
claus
parents:
diff changeset
  1724
        self redrawX:(width - margin - count) y:margin 
48194c26a46c Initial revision
claus
parents:
diff changeset
  1725
               width:count height:(height - m2).
48194c26a46c Initial revision
claus
parents:
diff changeset
  1726
48194c26a46c Initial revision
claus
parents:
diff changeset
  1727
        self originChanged:(count @ 0).
48194c26a46c Initial revision
claus
parents:
diff changeset
  1728
        self waitForExpose
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
scrollRight
48194c26a46c Initial revision
claus
parents:
diff changeset
  1733
    "scroll right by some amount
48194c26a46c Initial revision
claus
parents:
diff changeset
  1734
      - question is how much is a good default here"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1735
48194c26a46c Initial revision
claus
parents:
diff changeset
  1736
    self scrollRight:(device horizontalPixelPerMillimeter * 20) asInteger
48194c26a46c Initial revision
claus
parents:
diff changeset
  1737
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1738
48194c26a46c Initial revision
claus
parents:
diff changeset
  1739
!View methodsFor:'private'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1740
48194c26a46c Initial revision
claus
parents:
diff changeset
  1741
pixelExtent:extent
48194c26a46c Initial revision
claus
parents:
diff changeset
  1742
    "set the views extent in pixels"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1743
48194c26a46c Initial revision
claus
parents:
diff changeset
  1744
    |newWidth newHeight how mustRedrawBottomEdge mustRedrawRightEdge|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1745
48194c26a46c Initial revision
claus
parents:
diff changeset
  1746
    newWidth := extent x.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1747
    newHeight := extent y.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1748
    ((newWidth ~~ width) or:[newHeight ~~ height]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1749
        "shown "drawableId notNil"" ifTrue:[    "23-feb-93"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1750
            ((newHeight <= height) and:[newWidth <= width]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1751
                how := #smaller
48194c26a46c Initial revision
claus
parents:
diff changeset
  1752
            ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1753
48194c26a46c Initial revision
claus
parents:
diff changeset
  1754
            mustRedrawBottomEdge := (level ~~ 0) and:[newHeight < height].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1755
            mustRedrawRightEdge := (level ~~ 0) and:[newWidth < width].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1756
48194c26a46c Initial revision
claus
parents:
diff changeset
  1757
            (level ~~ 0) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1758
                "clear the old edges"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1759
48194c26a46c Initial revision
claus
parents:
diff changeset
  1760
                newWidth > width ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1761
                    self clipRect:nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1762
                    self paint:viewBackground.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1763
                    self fillRectangleX:(width - margin)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1764
                                      y:0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1765
                                  width:margin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1766
                                 height:height
48194c26a46c Initial revision
claus
parents:
diff changeset
  1767
                ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1768
                newHeight > height ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1769
                    self clipRect:nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1770
                    self paint:viewBackground.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1771
                    self fillRectangleX:0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1772
                                      y:(height - margin)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1773
                                  width:width
48194c26a46c Initial revision
claus
parents:
diff changeset
  1774
                                 height:margin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1775
                ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1776
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1777
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1778
48194c26a46c Initial revision
claus
parents:
diff changeset
  1779
        width := newWidth.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1780
        height := newHeight.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1781
48194c26a46c Initial revision
claus
parents:
diff changeset
  1782
        "shown "drawableId notNil"" ifTrue:[       "23-feb-93"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1783
            self setInnerClip.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1784
48194c26a46c Initial revision
claus
parents:
diff changeset
  1785
            (how == #smaller) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1786
                "if view becomes smaller, send sizeChanged first"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1787
                controller notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1788
                    controller sizeChanged:how of:self
48194c26a46c Initial revision
claus
parents:
diff changeset
  1789
                ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1790
                    self sizeChanged:how
48194c26a46c Initial revision
claus
parents:
diff changeset
  1791
                ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1792
            ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1793
48194c26a46c Initial revision
claus
parents:
diff changeset
  1794
            "have to tell X, when extent of view is changed"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1795
            device resizeWindow:drawableId width:width height:height.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1796
48194c26a46c Initial revision
claus
parents:
diff changeset
  1797
            "if view becomes bigger, send sizeChanged after"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1798
            (how ~~ #smaller) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1799
                controller notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1800
                    controller sizeChanged:how of:self
48194c26a46c Initial revision
claus
parents:
diff changeset
  1801
                ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1802
                    self sizeChanged:how
48194c26a46c Initial revision
claus
parents:
diff changeset
  1803
                ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1804
            ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1805
48194c26a46c Initial revision
claus
parents:
diff changeset
  1806
            (mustRedrawBottomEdge or:[mustRedrawRightEdge]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1807
                self clipRect:nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1808
                mustRedrawBottomEdge ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1809
                    self drawBottomEdge
48194c26a46c Initial revision
claus
parents:
diff changeset
  1810
                ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1811
                mustRedrawRightEdge ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1812
                    self drawRightEdge
48194c26a46c Initial revision
claus
parents:
diff changeset
  1813
                ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1814
                self clipRect:innerClipRect
48194c26a46c Initial revision
claus
parents:
diff changeset
  1815
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1816
        ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1817
            "otherwise memorize the need for a sizeChanged message"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1818
            extentChanged := true
48194c26a46c Initial revision
claus
parents:
diff changeset
  1819
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1820
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1821
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1822
48194c26a46c Initial revision
claus
parents:
diff changeset
  1823
pixelOrigin:origin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1824
    "set the views origin in pixels"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1825
48194c26a46c Initial revision
claus
parents:
diff changeset
  1826
    |newLeft newTop|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1827
48194c26a46c Initial revision
claus
parents:
diff changeset
  1828
    newLeft := origin x.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1829
    newTop := origin y.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1830
    ((newTop ~~ top) or:[newLeft ~~ left]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1831
        top := newTop.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1832
        left := newLeft.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1833
        drawableId notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1834
            "have to tell X, when origin of view is changed"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1835
            device moveWindow:drawableId x:left y:top
48194c26a46c Initial revision
claus
parents:
diff changeset
  1836
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1837
        realized ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1838
            originChanged := true
48194c26a46c Initial revision
claus
parents:
diff changeset
  1839
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1840
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1841
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1842
48194c26a46c Initial revision
claus
parents:
diff changeset
  1843
pixelCorner:corner
48194c26a46c Initial revision
claus
parents:
diff changeset
  1844
    "set the views corner in pixels"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1845
48194c26a46c Initial revision
claus
parents:
diff changeset
  1846
    |newWidth newHeight|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1847
48194c26a46c Initial revision
claus
parents:
diff changeset
  1848
    newWidth := corner x - left.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1849
    newHeight := corner y - top.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1850
    self pixelExtent:(newWidth @ newHeight)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1851
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1852
48194c26a46c Initial revision
claus
parents:
diff changeset
  1853
pixelOrigin:origin corner:corner
48194c26a46c Initial revision
claus
parents:
diff changeset
  1854
    "set the views origin and extent in pixels"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1855
48194c26a46c Initial revision
claus
parents:
diff changeset
  1856
    |newWidth newHeight|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1857
48194c26a46c Initial revision
claus
parents:
diff changeset
  1858
    newWidth := corner x - origin x.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1859
    newHeight := corner y - origin y.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1860
    self pixelOrigin:origin extent:(newWidth @ newHeight)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1861
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1862
48194c26a46c Initial revision
claus
parents:
diff changeset
  1863
pixelOrigin:origin extent:extent
48194c26a46c Initial revision
claus
parents:
diff changeset
  1864
    "set the views origin and extent in pixels"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1865
48194c26a46c Initial revision
claus
parents:
diff changeset
  1866
    |newLeft newTop newWidth newHeight how
48194c26a46c Initial revision
claus
parents:
diff changeset
  1867
     mustRedrawBottomEdge mustRedrawRightEdge|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1868
48194c26a46c Initial revision
claus
parents:
diff changeset
  1869
    newLeft := origin x.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1870
    newTop := origin y.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1871
    ((newTop == top) and:[newLeft == left]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1872
        ^ self pixelExtent:extent
48194c26a46c Initial revision
claus
parents:
diff changeset
  1873
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1874
    newWidth := extent x.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1875
    newHeight := extent y.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1876
    ((newWidth == width) and:[newHeight == height]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1877
        ^ self pixelOrigin:origin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1878
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1879
    top := newTop.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1880
    left := newLeft.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1881
48194c26a46c Initial revision
claus
parents:
diff changeset
  1882
    mustRedrawBottomEdge := (level ~~ 0) and:[newHeight < height].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1883
    mustRedrawRightEdge := (level ~~ 0) and:[newWidth < width].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1884
48194c26a46c Initial revision
claus
parents:
diff changeset
  1885
    width := newWidth.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1886
    height := newHeight.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1887
    ((newHeight <= height) and:[newWidth <= width]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1888
        how := #smaller
48194c26a46c Initial revision
claus
parents:
diff changeset
  1889
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1890
48194c26a46c Initial revision
claus
parents:
diff changeset
  1891
    "shown "drawableId notNil"" ifTrue:[        "23-feb-93"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1892
        (level ~~ 0) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1893
            "clear the old edges"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1894
48194c26a46c Initial revision
claus
parents:
diff changeset
  1895
            newWidth > width ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1896
                self clipRect:nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1897
                self paint:viewBackground.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1898
                self fillRectangleX:(width - margin)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1899
                                  y:0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1900
                              width:margin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1901
                             height:height
48194c26a46c Initial revision
claus
parents:
diff changeset
  1902
            ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1903
            newHeight > height ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1904
                self clipRect:nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1905
                self paint:viewBackground.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1906
                self fillRectangleX:0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1907
                                  y:(height - margin)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1908
                              width:width
48194c26a46c Initial revision
claus
parents:
diff changeset
  1909
                             height:margin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1910
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1911
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1912
48194c26a46c Initial revision
claus
parents:
diff changeset
  1913
        self setInnerClip.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1914
48194c26a46c Initial revision
claus
parents:
diff changeset
  1915
        "if view becomes smaller, send sizeChanged first"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1916
        (how == #smaller) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1917
            controller notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1918
               controller sizeChanged:how of:self
48194c26a46c Initial revision
claus
parents:
diff changeset
  1919
            ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1920
                self sizeChanged:how
48194c26a46c Initial revision
claus
parents:
diff changeset
  1921
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1922
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1923
48194c26a46c Initial revision
claus
parents:
diff changeset
  1924
        "have to tell X, when extent of view is changed"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1925
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1926
        (how == #smaller) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1927
            device resizeWindow:drawableId width:width height:height.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1928
            device moveWindow:drawableId x:left y:top
48194c26a46c Initial revision
claus
parents:
diff changeset
  1929
        ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1930
            device moveResizeWindow:drawableId x:left y:top width:width height:height
48194c26a46c Initial revision
claus
parents:
diff changeset
  1931
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1932
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1933
        device moveResizeWindow:drawableId x:left y:top
48194c26a46c Initial revision
claus
parents:
diff changeset
  1934
                                       width:width height:height.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1935
48194c26a46c Initial revision
claus
parents:
diff changeset
  1936
        "if view becomes bigger, send sizeChanged after"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1937
        (how ~~ #smaller) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1938
            controller notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1939
               controller sizeChanged:how of:self
48194c26a46c Initial revision
claus
parents:
diff changeset
  1940
            ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1941
                self sizeChanged:how
48194c26a46c Initial revision
claus
parents:
diff changeset
  1942
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1943
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1944
        (mustRedrawBottomEdge or:[mustRedrawRightEdge]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1945
            self clipRect:nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1946
            mustRedrawBottomEdge ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1947
                self drawBottomEdge
48194c26a46c Initial revision
claus
parents:
diff changeset
  1948
            ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1949
            mustRedrawRightEdge ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1950
                self drawRightEdge
48194c26a46c Initial revision
claus
parents:
diff changeset
  1951
            ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1952
            self clipRect:innerClipRect
48194c26a46c Initial revision
claus
parents:
diff changeset
  1953
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1954
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1955
        "otherwise memorize the need for a sizeChanged message"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1956
        originChanged := true.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1957
        extentChanged := true
48194c26a46c Initial revision
claus
parents:
diff changeset
  1958
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1959
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1960
48194c26a46c Initial revision
claus
parents:
diff changeset
  1961
pointFromRelativePoint:relativePoint
48194c26a46c Initial revision
claus
parents:
diff changeset
  1962
    "given relative point, compute absolute point (in pixels)"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1963
48194c26a46c Initial revision
claus
parents:
diff changeset
  1964
    |newX newY rel inRect|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1965
48194c26a46c Initial revision
claus
parents:
diff changeset
  1966
    superView isNil ifTrue:[^ nil].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1967
    inRect := superView viewRectangle.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1968
48194c26a46c Initial revision
claus
parents:
diff changeset
  1969
    rel := relativePoint x.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1970
    (rel isMemberOf:Float) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1971
        newX := (rel * (inRect width + (2 * borderWidth))) asInteger + inRect left
48194c26a46c Initial revision
claus
parents:
diff changeset
  1972
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1973
        newX := rel
48194c26a46c Initial revision
claus
parents:
diff changeset
  1974
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1975
    rel := relativePoint y.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1976
    (rel isMemberOf:Float) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1977
        newY := (rel * (inRect height + (2 * borderWidth))) asInteger + inRect top
48194c26a46c Initial revision
claus
parents:
diff changeset
  1978
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1979
        newY := rel
48194c26a46c Initial revision
claus
parents:
diff changeset
  1980
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1981
    ^ (newX @ newY)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1982
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1983
48194c26a46c Initial revision
claus
parents:
diff changeset
  1984
originFromRelativeOrigin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1985
    "compute pixel origin from relativeOrigin"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1986
48194c26a46c Initial revision
claus
parents:
diff changeset
  1987
    |newOrigin newX newY rel inRect bw2|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1988
48194c26a46c Initial revision
claus
parents:
diff changeset
  1989
    superView isNil ifTrue:[^ nil].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1990
48194c26a46c Initial revision
claus
parents:
diff changeset
  1991
    inRect := superView viewRectangle.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1992
    bw2 := borderWidth * 2.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1993
    rel := relativeOrigin x.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1994
    (rel isMemberOf:Float) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1995
        newX := (rel * (inRect width + bw2)) asInteger + inRect left
48194c26a46c Initial revision
claus
parents:
diff changeset
  1996
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  1997
        newX := rel
48194c26a46c Initial revision
claus
parents:
diff changeset
  1998
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1999
    rel := relativeOrigin y.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2000
    (rel isMemberOf:Float) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2001
        newY := (rel * (inRect height + bw2)) asInteger + inRect top
48194c26a46c Initial revision
claus
parents:
diff changeset
  2002
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2003
        newY := rel
48194c26a46c Initial revision
claus
parents:
diff changeset
  2004
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2005
    newOrigin :=  (newX @ newY).
48194c26a46c Initial revision
claus
parents:
diff changeset
  2006
48194c26a46c Initial revision
claus
parents:
diff changeset
  2007
    (borderWidth ~~ 0) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2008
        (relativeOrigin x isMemberOf:Float) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2009
            newOrigin x:(newOrigin x - borderWidth)
48194c26a46c Initial revision
claus
parents:
diff changeset
  2010
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2011
        (relativeOrigin y isMemberOf:Float) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2012
            newOrigin y:(newOrigin y - borderWidth)
48194c26a46c Initial revision
claus
parents:
diff changeset
  2013
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2014
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2015
    ^ newOrigin
48194c26a46c Initial revision
claus
parents:
diff changeset
  2016
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2017
48194c26a46c Initial revision
claus
parents:
diff changeset
  2018
cornerFromRelativeCorner
48194c26a46c Initial revision
claus
parents:
diff changeset
  2019
    "compute pixel corner from relativeCorner"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2020
48194c26a46c Initial revision
claus
parents:
diff changeset
  2021
    |newCorner newX newY rel inRect bw2|
48194c26a46c Initial revision
claus
parents:
diff changeset
  2022
48194c26a46c Initial revision
claus
parents:
diff changeset
  2023
    superView isNil ifTrue:[^ nil].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2024
48194c26a46c Initial revision
claus
parents:
diff changeset
  2025
    inRect := superView viewRectangle.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2026
    bw2 := borderWidth * 2.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2027
    rel := relativeCorner x.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2028
    (rel isMemberOf:Float) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2029
        newX := (rel * (inRect width" + bw2")) asInteger "+ inRect left"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2030
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2031
        newX := rel
48194c26a46c Initial revision
claus
parents:
diff changeset
  2032
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2033
    rel := relativeCorner y.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2034
    (rel isMemberOf:Float) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2035
        newY := (rel * (inRect height" + bw2")) asInteger "+ inRect top"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2036
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2037
        newY := rel
48194c26a46c Initial revision
claus
parents:
diff changeset
  2038
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2039
    newCorner :=  (newX @ newY).
48194c26a46c Initial revision
claus
parents:
diff changeset
  2040
48194c26a46c Initial revision
claus
parents:
diff changeset
  2041
    (borderWidth ~~ 0) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2042
        (relativeCorner x isMemberOf:Float) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2043
            newCorner x:(newCorner x - borderWidth)
48194c26a46c Initial revision
claus
parents:
diff changeset
  2044
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2045
        (relativeCorner y isMemberOf:Float) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2046
            newCorner y:(newCorner y - borderWidth)
48194c26a46c Initial revision
claus
parents:
diff changeset
  2047
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2048
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2049
    ^ newCorner
48194c26a46c Initial revision
claus
parents:
diff changeset
  2050
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2051
48194c26a46c Initial revision
claus
parents:
diff changeset
  2052
extentFromRelativeExtent
48194c26a46c Initial revision
claus
parents:
diff changeset
  2053
    "compute pixel extent from relativeExtent"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2054
48194c26a46c Initial revision
claus
parents:
diff changeset
  2055
    |newExtent newX newY rel inRect bw2|
48194c26a46c Initial revision
claus
parents:
diff changeset
  2056
48194c26a46c Initial revision
claus
parents:
diff changeset
  2057
    superView isNil ifTrue:[^ nil].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2058
48194c26a46c Initial revision
claus
parents:
diff changeset
  2059
    inRect := superView viewRectangle.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2060
    bw2 := borderWidth * 2.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2061
    rel := relativeExtent x.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2062
    (rel isMemberOf:Float) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2063
        newX := (rel * (inRect width + bw2)) asInteger + inRect left
48194c26a46c Initial revision
claus
parents:
diff changeset
  2064
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2065
        newX := rel
48194c26a46c Initial revision
claus
parents:
diff changeset
  2066
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2067
    rel := relativeExtent y.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2068
    (rel isMemberOf:Float) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2069
        newY := (rel * (inRect height + bw2)) asInteger + inRect top
48194c26a46c Initial revision
claus
parents:
diff changeset
  2070
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2071
        newY := rel
48194c26a46c Initial revision
claus
parents:
diff changeset
  2072
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2073
    newExtent :=  (newX @ newY).
48194c26a46c Initial revision
claus
parents:
diff changeset
  2074
48194c26a46c Initial revision
claus
parents:
diff changeset
  2075
    (borderWidth ~~ 0) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2076
        (relativeExtent x isMemberOf:Float) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2077
            newExtent x:(newExtent x - (1 * borderWidth))
48194c26a46c Initial revision
claus
parents:
diff changeset
  2078
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2079
        (relativeExtent y isMemberOf:Float) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2080
            newExtent y:(newExtent y - (1 * borderWidth))
48194c26a46c Initial revision
claus
parents:
diff changeset
  2081
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2082
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2083
    ^ newExtent
48194c26a46c Initial revision
claus
parents:
diff changeset
  2084
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2085
48194c26a46c Initial revision
claus
parents:
diff changeset
  2086
dimensionFromViewport
48194c26a46c Initial revision
claus
parents:
diff changeset
  2087
    "define my origin/extend from viewport"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2088
48194c26a46c Initial revision
claus
parents:
diff changeset
  2089
    |relW relH relX relY winW winH org ext|
48194c26a46c Initial revision
claus
parents:
diff changeset
  2090
48194c26a46c Initial revision
claus
parents:
diff changeset
  2091
    superView notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2092
        superView window isNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2093
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2094
            v := superView.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2095
            (v notNil and:[v window isNil]) whileTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2096
                v := v superview
48194c26a46c Initial revision
claus
parents:
diff changeset
  2097
            ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2098
            v notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2099
                w := v window
48194c26a46c Initial revision
claus
parents:
diff changeset
  2100
            ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2101
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2102
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2103
            winW := 1.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2104
            winH := 1
48194c26a46c Initial revision
claus
parents:
diff changeset
  2105
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2106
            winW := superView width.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2107
            winH := superView height.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2108
48194c26a46c Initial revision
claus
parents:
diff changeset
  2109
        ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2110
            winW := superView window width.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2111
            winH := superView window height
48194c26a46c Initial revision
claus
parents:
diff changeset
  2112
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2113
        relW := (viewport width / winW) asFloat.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2114
        relH := (viewport height / winH) asFloat.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2115
        relX := (viewport left / winW) asFloat.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2116
        relY := (viewport top / winH) asFloat.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2117
        relativeOrigin := (relX @ relY).
48194c26a46c Initial revision
claus
parents:
diff changeset
  2118
        org := self originFromRelativeOrigin.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2119
        relativeOrigin := nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2120
48194c26a46c Initial revision
claus
parents:
diff changeset
  2121
        relativeExtent := (relW @ relH).
48194c26a46c Initial revision
claus
parents:
diff changeset
  2122
        ext := self extentFromRelativeExtent.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2123
        relativeExtent := nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2124
48194c26a46c Initial revision
claus
parents:
diff changeset
  2125
        self pixelOrigin:org extent:ext.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2126
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2127
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2128
48194c26a46c Initial revision
claus
parents:
diff changeset
  2129
computeInnerClip
48194c26a46c Initial revision
claus
parents:
diff changeset
  2130
    |m2|
48194c26a46c Initial revision
claus
parents:
diff changeset
  2131
48194c26a46c Initial revision
claus
parents:
diff changeset
  2132
    (margin ~~ 0) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2133
        m2 := margin + margin.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2134
        innerClipRect := Rectangle left:margin top:margin
48194c26a46c Initial revision
claus
parents:
diff changeset
  2135
                                 width:(width - m2) height:(height - m2)
48194c26a46c Initial revision
claus
parents:
diff changeset
  2136
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2137
        innerClipRect := nil
48194c26a46c Initial revision
claus
parents:
diff changeset
  2138
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2139
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2140
48194c26a46c Initial revision
claus
parents:
diff changeset
  2141
setInnerClip
48194c26a46c Initial revision
claus
parents:
diff changeset
  2142
    |m2|
48194c26a46c Initial revision
claus
parents:
diff changeset
  2143
48194c26a46c Initial revision
claus
parents:
diff changeset
  2144
    (margin ~~ 0) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2145
        m2 := margin + margin.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2146
        innerClipRect := Rectangle left:margin top:margin
48194c26a46c Initial revision
claus
parents:
diff changeset
  2147
                                  width:(width - m2)
48194c26a46c Initial revision
claus
parents:
diff changeset
  2148
                                 height:(height - m2)
48194c26a46c Initial revision
claus
parents:
diff changeset
  2149
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2150
        innerClipRect := nil
48194c26a46c Initial revision
claus
parents:
diff changeset
  2151
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2152
    self clipRect:innerClipRect
48194c26a46c Initial revision
claus
parents:
diff changeset
  2153
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  2154
48194c26a46c Initial revision
claus
parents:
diff changeset
  2155
!View methodsFor:'realization'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2156
48194c26a46c Initial revision
claus
parents:
diff changeset
  2157
create
48194c26a46c Initial revision
claus
parents:
diff changeset
  2158
    "create (i.e. tell X about me)
48194c26a46c Initial revision
claus
parents:
diff changeset
  2159
     this is kind of stupid - creation means XCreateWindow;
48194c26a46c Initial revision
claus
parents:
diff changeset
  2160
     realizing means XMapWindow"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2161
48194c26a46c Initial revision
claus
parents:
diff changeset
  2162
    drawableId isNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2163
        "make certain, superview is created also"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2164
48194c26a46c Initial revision
claus
parents:
diff changeset
  2165
        superView notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2166
            superView id isNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2167
                superView create
48194c26a46c Initial revision
claus
parents:
diff changeset
  2168
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2169
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2170
48194c26a46c Initial revision
claus
parents:
diff changeset
  2171
        "associate cursor/colors to device"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2172
48194c26a46c Initial revision
claus
parents:
diff changeset
  2173
        viewBackground := viewBackground on:device.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2174
        borderColor := borderColor on:device.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2175
        shadowColor := shadowColor on:device.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2176
        lightColor := lightColor on:device.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2177
        cursor := cursor on:device.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2178
48194c26a46c Initial revision
claus
parents:
diff changeset
  2179
        drawableId := device createWindowFor:self 
48194c26a46c Initial revision
claus
parents:
diff changeset
  2180
                                        left:left top:top 
48194c26a46c Initial revision
claus
parents:
diff changeset
  2181
                                       width:width height:height.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2182
48194c26a46c Initial revision
claus
parents:
diff changeset
  2183
        extentChanged := false.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2184
        originChanged := false.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2185
48194c26a46c Initial revision
claus
parents:
diff changeset
  2186
        borderShape notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2187
            device setWindowBorderShape:(borderShape id) in:drawableId
48194c26a46c Initial revision
claus
parents:
diff changeset
  2188
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2189
        viewShape notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2190
            device setWindowShape:(viewShape id) in:drawableId
48194c26a46c Initial revision
claus
parents:
diff changeset
  2191
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2192
        backed notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2193
            device setBackingStore:backed in:drawableId
48194c26a46c Initial revision
claus
parents:
diff changeset
  2194
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2195
        saveUnder ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2196
            device setSaveUnder:true in:drawableId
48194c26a46c Initial revision
claus
parents:
diff changeset
  2197
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2198
48194c26a46c Initial revision
claus
parents:
diff changeset
  2199
        font := font on:device.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2200
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2201
        self inputOnly ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2202
            self initGC
48194c26a46c Initial revision
claus
parents:
diff changeset
  2203
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2204
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2205
        self initializeMiddleButtonMenu.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2206
        self initEvents.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2207
        controller notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2208
            controller created:self
48194c26a46c Initial revision
claus
parents:
diff changeset
  2209
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2210
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2211
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2212
48194c26a46c Initial revision
claus
parents:
diff changeset
  2213
createWithAllSubViews
48194c26a46c Initial revision
claus
parents:
diff changeset
  2214
    "create, then create all subviews"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2215
48194c26a46c Initial revision
claus
parents:
diff changeset
  2216
    drawableId isNil ifTrue:[self create].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2217
    subViews notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2218
        subViews do:[:subView | subView createWithAllSubViews]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2219
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2220
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2221
48194c26a46c Initial revision
claus
parents:
diff changeset
  2222
initializeMiddleButtonMenu
48194c26a46c Initial revision
claus
parents:
diff changeset
  2223
    "a place to initialize menu - this one is sent once when the view is
48194c26a46c Initial revision
claus
parents:
diff changeset
  2224
     first created; usually redefined in subclasses; default here is no menu"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2225
48194c26a46c Initial revision
claus
parents:
diff changeset
  2226
    ^ self
48194c26a46c Initial revision
claus
parents:
diff changeset
  2227
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2228
48194c26a46c Initial revision
claus
parents:
diff changeset
  2229
fixSize
48194c26a46c Initial revision
claus
parents:
diff changeset
  2230
    "adjust size of window according to either relative/abs or
48194c26a46c Initial revision
claus
parents:
diff changeset
  2231
     block extent; also set origin"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2232
48194c26a46c Initial revision
claus
parents:
diff changeset
  2233
    window notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2234
        ^ self superViewChangedSize
48194c26a46c Initial revision
claus
parents:
diff changeset
  2235
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2236
48194c26a46c Initial revision
claus
parents:
diff changeset
  2237
    "if the extent is not the one we created the window with ..."
48194c26a46c Initial revision
claus
parents:
diff changeset
  2238
    extentChanged ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2239
        controller notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2240
            controller sizeChanged:nil of:self
48194c26a46c Initial revision
claus
parents:
diff changeset
  2241
        ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2242
            self sizeChanged:nil
48194c26a46c Initial revision
claus
parents:
diff changeset
  2243
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2244
        extentChanged := false
48194c26a46c Initial revision
claus
parents:
diff changeset
  2245
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2246
48194c26a46c Initial revision
claus
parents:
diff changeset
  2247
    originChanged ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2248
        originRule notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2249
            self pixelOrigin:(originRule value)
48194c26a46c Initial revision
claus
parents:
diff changeset
  2250
        ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2251
            relativeOrigin notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2252
                self originFromRelativeOrigin
48194c26a46c Initial revision
claus
parents:
diff changeset
  2253
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2254
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2255
        originChanged := false
48194c26a46c Initial revision
claus
parents:
diff changeset
  2256
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2257
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2258
48194c26a46c Initial revision
claus
parents:
diff changeset
  2259
realize
48194c26a46c Initial revision
claus
parents:
diff changeset
  2260
    "realize - make visible;
48194c26a46c Initial revision
claus
parents:
diff changeset
  2261
     realizing is done very late (after layout is fixed) to avoid
48194c26a46c Initial revision
claus
parents:
diff changeset
  2262
     visible rearranging of windows on the screen"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2263
48194c26a46c Initial revision
claus
parents:
diff changeset
  2264
    drawableId isNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2265
        self create.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2266
        "if it is the first realize (which means a create),
48194c26a46c Initial revision
claus
parents:
diff changeset
  2267
         force sizechange messages"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2268
        extentChanged := true.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2269
        originChanged := true
48194c26a46c Initial revision
claus
parents:
diff changeset
  2270
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2271
48194c26a46c Initial revision
claus
parents:
diff changeset
  2272
    hidden ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2273
        ^ self
48194c26a46c Initial revision
claus
parents:
diff changeset
  2274
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2275
48194c26a46c Initial revision
claus
parents:
diff changeset
  2276
    realized ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2277
        (originChanged or:[extentChanged]) ifTrue:[self fixSize].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2278
        subViews notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2279
            subViews do:[:subView |
48194c26a46c Initial revision
claus
parents:
diff changeset
  2280
                subView realize
48194c26a46c Initial revision
claus
parents:
diff changeset
  2281
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2282
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2283
        self setInnerClip.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2284
48194c26a46c Initial revision
claus
parents:
diff changeset
  2285
        "and make it visible"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2286
        device mapWindow:drawableId.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2287
        realized := true
48194c26a46c Initial revision
claus
parents:
diff changeset
  2288
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2289
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2290
48194c26a46c Initial revision
claus
parents:
diff changeset
  2291
rerealize
48194c26a46c Initial revision
claus
parents:
diff changeset
  2292
    "rerealize at old position"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2293
48194c26a46c Initial revision
claus
parents:
diff changeset
  2294
    device mapWindow:drawableId iconified:false
48194c26a46c Initial revision
claus
parents:
diff changeset
  2295
                                      atX:left y:top
48194c26a46c Initial revision
claus
parents:
diff changeset
  2296
                                    width:width height:height
48194c26a46c Initial revision
claus
parents:
diff changeset
  2297
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2298
48194c26a46c Initial revision
claus
parents:
diff changeset
  2299
destroy
48194c26a46c Initial revision
claus
parents:
diff changeset
  2300
    "unrealize & destroy - make me invisible, destroy subviews then
48194c26a46c Initial revision
claus
parents:
diff changeset
  2301
     make me unknown to the device"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2302
48194c26a46c Initial revision
claus
parents:
diff changeset
  2303
    realized ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2304
        self unrealize.            
48194c26a46c Initial revision
claus
parents:
diff changeset
  2305
        device synchronizeOutput. "make it go away immediately
48194c26a46c Initial revision
claus
parents:
diff changeset
  2306
                                   - also, this hides the subview killing"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2307
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2308
48194c26a46c Initial revision
claus
parents:
diff changeset
  2309
    model notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2310
        model removeDependent:self
48194c26a46c Initial revision
claus
parents:
diff changeset
  2311
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2312
    controller := nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2313
48194c26a46c Initial revision
claus
parents:
diff changeset
  2314
    [subViews notNil] whileTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2315
        (subViews at:1) destroy
48194c26a46c Initial revision
claus
parents:
diff changeset
  2316
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2317
    superView notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2318
        superView removeSubView:self.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2319
        superView := nil
48194c26a46c Initial revision
claus
parents:
diff changeset
  2320
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2321
    super destroy
48194c26a46c Initial revision
claus
parents:
diff changeset
  2322
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2323
48194c26a46c Initial revision
claus
parents:
diff changeset
  2324
unrealize
48194c26a46c Initial revision
claus
parents:
diff changeset
  2325
    "hide me"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2326
48194c26a46c Initial revision
claus
parents:
diff changeset
  2327
    realized ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2328
        drawableId notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2329
            device unmapWindow:drawableId
48194c26a46c Initial revision
claus
parents:
diff changeset
  2330
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2331
        realized := false.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2332
        shown := false "23-feb-93"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2333
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2334
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  2335
48194c26a46c Initial revision
claus
parents:
diff changeset
  2336
!View methodsFor:'drawing'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2337
48194c26a46c Initial revision
claus
parents:
diff changeset
  2338
drawEdgesForX:x y:y width:w height:h level:l 
48194c26a46c Initial revision
claus
parents:
diff changeset
  2339
                shadow:shadowColor light:lightColor
48194c26a46c Initial revision
claus
parents:
diff changeset
  2340
                halfShadow:halfShadowColor halfLight:halfLightColor
48194c26a46c Initial revision
claus
parents:
diff changeset
  2341
    "draw 3D edges into a rectangle"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2342
48194c26a46c Initial revision
claus
parents:
diff changeset
  2343
    |topLeftFg botRightFg topLeftHalfFg botRightHalfFg
48194c26a46c Initial revision
claus
parents:
diff changeset
  2344
     count "{ Class: SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2345
     r     "{ Class: SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2346
     b     "{ Class: SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2347
     xi    "{ Class: SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2348
     yi    "{ Class: SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2349
     run |
48194c26a46c Initial revision
claus
parents:
diff changeset
  2350
48194c26a46c Initial revision
claus
parents:
diff changeset
  2351
    (l < 0) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2352
        topLeftFg := shadowColor.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2353
        botRightFg := lightColor.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2354
        topLeftHalfFg := halfShadowColor.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2355
        botRightHalfFg := halfLightColor.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2356
        count := l negated
48194c26a46c Initial revision
claus
parents:
diff changeset
  2357
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2358
        topLeftFg := lightColor.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2359
        botRightFg := shadowColor.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2360
        topLeftHalfFg := halfLightColor.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2361
        botRightHalfFg := halfShadowColor.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2362
        count := l
48194c26a46c Initial revision
claus
parents:
diff changeset
  2363
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2364
    r := x + w - 1. "right"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2365
    b := y + h - 1. "bottom"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2366
48194c26a46c Initial revision
claus
parents:
diff changeset
  2367
    super lineWidth:0.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2368
48194c26a46c Initial revision
claus
parents:
diff changeset
  2369
    "top and left edges"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2370
    (softEdge and:[l > 0]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2371
        super paint:topLeftHalfFg
48194c26a46c Initial revision
claus
parents:
diff changeset
  2372
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2373
        super paint:topLeftFg
48194c26a46c Initial revision
claus
parents:
diff changeset
  2374
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2375
    0 to:(count - 1) do:[:i |
48194c26a46c Initial revision
claus
parents:
diff changeset
  2376
        run := y + i.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2377
        super displayLineFromX:x y:run toX:r y:run. "top"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2378
        run := x + i.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2379
        super displayLineFromX:run y:y toX:run y:b  "left"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2380
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2381
    softEdge ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2382
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2383
        super paint:topLeftFg.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2384
        super displayLineFromX:x y:y toX:r y:y. 
48194c26a46c Initial revision
claus
parents:
diff changeset
  2385
        super displayLineFromX:x y:y toX:x y:b        
48194c26a46c Initial revision
claus
parents:
diff changeset
  2386
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2387
        (l > 2) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2388
            super paint:Black.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2389
            super displayLineFromX:x y:y toX:r y:y. 
48194c26a46c Initial revision
claus
parents:
diff changeset
  2390
            super displayLineFromX:x y:y toX:x y:b. 
48194c26a46c Initial revision
claus
parents:
diff changeset
  2391
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2392
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2393
48194c26a46c Initial revision
claus
parents:
diff changeset
  2394
    xi := x + 1.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2395
    yi := y + 1.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2396
48194c26a46c Initial revision
claus
parents:
diff changeset
  2397
    "bottom and right edges"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2398
    (softEdge) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2399
        super paint:botRightHalfFg
48194c26a46c Initial revision
claus
parents:
diff changeset
  2400
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2401
        super paint:botRightFg
48194c26a46c Initial revision
claus
parents:
diff changeset
  2402
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2403
    0 to:(count - 1) do:[:i |
48194c26a46c Initial revision
claus
parents:
diff changeset
  2404
        run := b - i.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2405
        super displayLineFromX:xi-1 y:run toX:r y:run. "bottom"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2406
        run := r - i.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2407
        super displayLineFromX:run y:yi-1 toX:run y:b.  "right"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2408
        xi := xi + 1.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2409
        yi := yi + 1
48194c26a46c Initial revision
claus
parents:
diff changeset
  2410
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2411
    (softEdge and:[l > 1]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2412
        super paint:shadowColor.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2413
        super displayLineFromX:(x + 1-1) y:b toX:r y:b. 
48194c26a46c Initial revision
claus
parents:
diff changeset
  2414
        super displayLineFromX:r y:(y + 1 - 1) toX:r y:b        
48194c26a46c Initial revision
claus
parents:
diff changeset
  2415
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2416
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2417
48194c26a46c Initial revision
claus
parents:
diff changeset
  2418
drawEdgesForX:x y:y width:w height:h level:l
48194c26a46c Initial revision
claus
parents:
diff changeset
  2419
    "draw 3D edges into a rectangle"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2420
48194c26a46c Initial revision
claus
parents:
diff changeset
  2421
    self drawEdgesForX:x y:y width:w height:h level:l 
48194c26a46c Initial revision
claus
parents:
diff changeset
  2422
                shadow:shadowColor light:lightColor
48194c26a46c Initial revision
claus
parents:
diff changeset
  2423
                halfShadow:halfShadowColor halfLight:halfLightColor
48194c26a46c Initial revision
claus
parents:
diff changeset
  2424
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2425
48194c26a46c Initial revision
claus
parents:
diff changeset
  2426
drawLeftEdge
48194c26a46c Initial revision
claus
parents:
diff changeset
  2427
    "draw left 3D edge into window frame"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2428
48194c26a46c Initial revision
claus
parents:
diff changeset
  2429
    |leftFg leftHalfFg
48194c26a46c Initial revision
claus
parents:
diff changeset
  2430
     count "{ Class: SmallInteger }" |
48194c26a46c Initial revision
claus
parents:
diff changeset
  2431
48194c26a46c Initial revision
claus
parents:
diff changeset
  2432
    (level < 0) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2433
        leftFg := shadowColor.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2434
        leftHalfFg := halfShadowColor.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2435
        count := level negated
48194c26a46c Initial revision
claus
parents:
diff changeset
  2436
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2437
        leftFg := lightColor.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2438
        leftHalfFg := halfLightColor.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2439
        count := level
48194c26a46c Initial revision
claus
parents:
diff changeset
  2440
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2441
48194c26a46c Initial revision
claus
parents:
diff changeset
  2442
    super lineWidth:0.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2443
    (softEdge and:[level > 0]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2444
        super paint:leftHalfFg
48194c26a46c Initial revision
claus
parents:
diff changeset
  2445
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2446
        super paint:leftFg
48194c26a46c Initial revision
claus
parents:
diff changeset
  2447
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2448
    0 to:(count - 1) do:[:i |
48194c26a46c Initial revision
claus
parents:
diff changeset
  2449
        super displayLineFromX:i y:i toX:i y:(height - 1 - i)
48194c26a46c Initial revision
claus
parents:
diff changeset
  2450
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2451
    (softEdge and:[level > 2]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2452
        super paint:Black.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2453
        super displayLineFromX:0 y:0 toX:0 y:height-1. 
48194c26a46c Initial revision
claus
parents:
diff changeset
  2454
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2455
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2456
48194c26a46c Initial revision
claus
parents:
diff changeset
  2457
drawRightEdge
48194c26a46c Initial revision
claus
parents:
diff changeset
  2458
    "draw right 3D edge into window frame"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2459
48194c26a46c Initial revision
claus
parents:
diff changeset
  2460
    |rightFg
48194c26a46c Initial revision
claus
parents:
diff changeset
  2461
     count "{ Class: SmallInteger }" 
48194c26a46c Initial revision
claus
parents:
diff changeset
  2462
     r|
48194c26a46c Initial revision
claus
parents:
diff changeset
  2463
48194c26a46c Initial revision
claus
parents:
diff changeset
  2464
    (level < 0) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2465
        rightFg := lightColor.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2466
        count := level negated
48194c26a46c Initial revision
claus
parents:
diff changeset
  2467
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2468
        (softEdge and:[level > 1]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2469
            rightFg := halfShadowColor
48194c26a46c Initial revision
claus
parents:
diff changeset
  2470
        ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2471
            rightFg := shadowColor
48194c26a46c Initial revision
claus
parents:
diff changeset
  2472
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2473
        count := level
48194c26a46c Initial revision
claus
parents:
diff changeset
  2474
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2475
48194c26a46c Initial revision
claus
parents:
diff changeset
  2476
    super lineWidth:0.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2477
    super paint:rightFg.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2478
    0 to:(count - 1) do:[:i |
48194c26a46c Initial revision
claus
parents:
diff changeset
  2479
        r := width - 1 - i.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2480
        super displayLineFromX:r y:i toX:r y:(height - 1 - i)
48194c26a46c Initial revision
claus
parents:
diff changeset
  2481
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2482
    (softEdge and:[level > 1]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2483
        super paint:shadowColor.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2484
        super displayLineFromX:width-1 y:1 toX:width-1 y:height-1. 
48194c26a46c Initial revision
claus
parents:
diff changeset
  2485
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2486
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2487
48194c26a46c Initial revision
claus
parents:
diff changeset
  2488
drawTopEdge
48194c26a46c Initial revision
claus
parents:
diff changeset
  2489
    "draw top 3D edge into window frame"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2490
48194c26a46c Initial revision
claus
parents:
diff changeset
  2491
    |topFg topHalfFg
48194c26a46c Initial revision
claus
parents:
diff changeset
  2492
     count "{ Class: SmallInteger }" |
48194c26a46c Initial revision
claus
parents:
diff changeset
  2493
48194c26a46c Initial revision
claus
parents:
diff changeset
  2494
    (level < 0) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2495
        topFg := shadowColor.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2496
        topHalfFg := halfShadowColor.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2497
        count := level negated
48194c26a46c Initial revision
claus
parents:
diff changeset
  2498
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2499
        topFg := lightColor.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2500
        topHalfFg := halfLightColor.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2501
        count := level
48194c26a46c Initial revision
claus
parents:
diff changeset
  2502
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2503
48194c26a46c Initial revision
claus
parents:
diff changeset
  2504
    super lineWidth:0.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2505
    (softEdge and:[level > 0]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2506
        super paint:topHalfFg
48194c26a46c Initial revision
claus
parents:
diff changeset
  2507
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2508
        super paint:topFg
48194c26a46c Initial revision
claus
parents:
diff changeset
  2509
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2510
    0 to:(count - 1) do:[:i |
48194c26a46c Initial revision
claus
parents:
diff changeset
  2511
        super displayLineFromX:i y:i toX:(width - 1 - i) y:i
48194c26a46c Initial revision
claus
parents:
diff changeset
  2512
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2513
    (softEdge and:[level > 2]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2514
        super paint:Black.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2515
        super displayLineFromX:0 y:0 toX:width-1 y:0. 
48194c26a46c Initial revision
claus
parents:
diff changeset
  2516
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2517
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2518
48194c26a46c Initial revision
claus
parents:
diff changeset
  2519
drawBottomEdge
48194c26a46c Initial revision
claus
parents:
diff changeset
  2520
    "draw bottom 3D edge into window frame"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2521
48194c26a46c Initial revision
claus
parents:
diff changeset
  2522
    |botFg
48194c26a46c Initial revision
claus
parents:
diff changeset
  2523
     count "{ Class: SmallInteger }" 
48194c26a46c Initial revision
claus
parents:
diff changeset
  2524
     b|
48194c26a46c Initial revision
claus
parents:
diff changeset
  2525
48194c26a46c Initial revision
claus
parents:
diff changeset
  2526
    (level < 0) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2527
        botFg := lightColor.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2528
        count := level negated
48194c26a46c Initial revision
claus
parents:
diff changeset
  2529
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2530
        (softEdge and:[level > 1]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2531
            botFg := halfShadowColor
48194c26a46c Initial revision
claus
parents:
diff changeset
  2532
        ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2533
            botFg := shadowColor
48194c26a46c Initial revision
claus
parents:
diff changeset
  2534
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2535
        count := level
48194c26a46c Initial revision
claus
parents:
diff changeset
  2536
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2537
48194c26a46c Initial revision
claus
parents:
diff changeset
  2538
    super lineWidth:0.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2539
    super paint:botFg.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2540
    0 to:(count - 1) do:[:i |
48194c26a46c Initial revision
claus
parents:
diff changeset
  2541
        b := height - 1 - i.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2542
        super displayLineFromX:i y:b toX:(width "- 1" - i) y:b
48194c26a46c Initial revision
claus
parents:
diff changeset
  2543
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2544
    (softEdge and:[level > 1]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2545
        super paint:shadowColor.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2546
        super displayLineFromX:1 y:height-1 toX:width-1 y:height-1. 
48194c26a46c Initial revision
claus
parents:
diff changeset
  2547
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2548
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2549
48194c26a46c Initial revision
claus
parents:
diff changeset
  2550
redrawEdges
48194c26a46c Initial revision
claus
parents:
diff changeset
  2551
    "redraw my edges if 3D"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2552
48194c26a46c Initial revision
claus
parents:
diff changeset
  2553
    self is3D ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2554
        (level ~~ 0) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2555
            self clipRect:nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2556
            self drawEdgesForX:0 y:0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2557
                         width:width height:height
48194c26a46c Initial revision
claus
parents:
diff changeset
  2558
                         level:level.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2559
            self clipRect:innerClipRect
48194c26a46c Initial revision
claus
parents:
diff changeset
  2560
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2561
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2562
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2563
48194c26a46c Initial revision
claus
parents:
diff changeset
  2564
redraw
48194c26a46c Initial revision
claus
parents:
diff changeset
  2565
    "redraw myself
48194c26a46c Initial revision
claus
parents:
diff changeset
  2566
     if there is a model, this one shall redraw itself,
48194c26a46c Initial revision
claus
parents:
diff changeset
  2567
     otherwise we cannot do much here - has to be redefined in subclasses"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2568
48194c26a46c Initial revision
claus
parents:
diff changeset
  2569
    model notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2570
        model update:self
48194c26a46c Initial revision
claus
parents:
diff changeset
  2571
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2572
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2573
48194c26a46c Initial revision
claus
parents:
diff changeset
  2574
redrawX:x y:y width:w height:h
48194c26a46c Initial revision
claus
parents:
diff changeset
  2575
    "have to redraw part -
48194c26a46c Initial revision
claus
parents:
diff changeset
  2576
     default is to redraw everything - subclasses should add intelligence"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2577
48194c26a46c Initial revision
claus
parents:
diff changeset
  2578
    |area|
48194c26a46c Initial revision
claus
parents:
diff changeset
  2579
48194c26a46c Initial revision
claus
parents:
diff changeset
  2580
    area := Rectangle left:x top:y width:w height:h.      
48194c26a46c Initial revision
claus
parents:
diff changeset
  2581
    self clippedTo:area do:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2582
        controller notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2583
            "ST-80 updating"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2584
            self update:#rectangle with:area
48194c26a46c Initial revision
claus
parents:
diff changeset
  2585
        ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2586
            components notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2587
                components do:[:aComponent |
48194c26a46c Initial revision
claus
parents:
diff changeset
  2588
                    (aComponent frame intersects:area) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2589
                        aComponent drawIn:self offset:0@0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2590
                    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2591
                ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2592
            ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2593
                self redraw
48194c26a46c Initial revision
claus
parents:
diff changeset
  2594
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2595
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2596
    ]                                                              
48194c26a46c Initial revision
claus
parents:
diff changeset
  2597
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  2598
48194c26a46c Initial revision
claus
parents:
diff changeset
  2599
!View methodsFor:'events'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2600
48194c26a46c Initial revision
claus
parents:
diff changeset
  2601
sizeChanged:how
48194c26a46c Initial revision
claus
parents:
diff changeset
  2602
    "tell subviews if I change size"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2603
48194c26a46c Initial revision
claus
parents:
diff changeset
  2604
    transformation := nil.  "transformation becomes void"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2605
    subViews notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2606
        (how == #smaller) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2607
            subViews do:[:view |
48194c26a46c Initial revision
claus
parents:
diff changeset
  2608
                view superViewChangedSize
48194c26a46c Initial revision
claus
parents:
diff changeset
  2609
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2610
        ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2611
            "doing it reverse speeds up resizing - usually subviews
48194c26a46c Initial revision
claus
parents:
diff changeset
  2612
             are created from top-left to bottom-right; therefore
48194c26a46c Initial revision
claus
parents:
diff changeset
  2613
             bottom-right views will be moved/resized first, then top-left ones;
48194c26a46c Initial revision
claus
parents:
diff changeset
  2614
             this avoids multiple redraws of subviews"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2615
48194c26a46c Initial revision
claus
parents:
diff changeset
  2616
            subViews reverseDo:[:view |
48194c26a46c Initial revision
claus
parents:
diff changeset
  2617
                view superViewChangedSize
48194c26a46c Initial revision
claus
parents:
diff changeset
  2618
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2619
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2620
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2621
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2622
48194c26a46c Initial revision
claus
parents:
diff changeset
  2623
superViewChangedSize
48194c26a46c Initial revision
claus
parents:
diff changeset
  2624
    "my superView has changed size; if I have relative
48194c26a46c Initial revision
claus
parents:
diff changeset
  2625
     origin/extent or blocks to evaluate, do it now .."
48194c26a46c Initial revision
claus
parents:
diff changeset
  2626
48194c26a46c Initial revision
claus
parents:
diff changeset
  2627
    |oldWidth oldHeight oldTop oldLeft newExt newOrg
48194c26a46c Initial revision
claus
parents:
diff changeset
  2628
     winSuper newWidth newHeight newLeft newTop newCorner
48194c26a46c Initial revision
claus
parents:
diff changeset
  2629
     superWidth superHeight superWinWidth superWinHeight|
48194c26a46c Initial revision
claus
parents:
diff changeset
  2630
48194c26a46c Initial revision
claus
parents:
diff changeset
  2631
    oldWidth := width.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2632
    oldHeight := height.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2633
    oldTop := top.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2634
    oldLeft := left.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2635
48194c26a46c Initial revision
claus
parents:
diff changeset
  2636
    viewport notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2637
        "if this view has a viewPort, resize a la st-80"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2638
        superView isNil ifTrue:[^ self].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2639
        winSuper := superView window.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2640
        winSuper isNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2641
            "take pixel size as window"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2642
            winSuper := 0@0 extent:(superView width@superView height)
48194c26a46c Initial revision
claus
parents:
diff changeset
  2643
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2644
48194c26a46c Initial revision
claus
parents:
diff changeset
  2645
48194c26a46c Initial revision
claus
parents:
diff changeset
  2646
        superWidth := superView width.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2647
        superHeight := superView height.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2648
        superWinWidth := winSuper width.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2649
        superWinHeight := winSuper height.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2650
        newLeft := (viewport left - winSuper left) * superWidth // superWinWidth.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2651
        newTop := (viewport top - winSuper top) * superHeight // superWinHeight.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2652
        newWidth := superWidth * viewport width // superWinWidth.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2653
        newHeight := superHeight * viewport height // superWinHeight.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2654
        self pixelOrigin:(newLeft @ newTop).
48194c26a46c Initial revision
claus
parents:
diff changeset
  2655
        self pixelExtent:(newWidth @ newHeight).
48194c26a46c Initial revision
claus
parents:
diff changeset
  2656
        ^ self
48194c26a46c Initial revision
claus
parents:
diff changeset
  2657
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2658
48194c26a46c Initial revision
claus
parents:
diff changeset
  2659
    (originRule notNil) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2660
        newOrg := originRule value
48194c26a46c Initial revision
claus
parents:
diff changeset
  2661
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2662
        (relativeOrigin notNil) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2663
            "self originFromRelativeOrigin      "
48194c26a46c Initial revision
claus
parents:
diff changeset
  2664
            newOrg := self originFromRelativeOrigin.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2665
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2666
            borderWidth ~~ 0 ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2667
                newOrg := newOrg - (borderWidth @ borderWidth)
48194c26a46c Initial revision
claus
parents:
diff changeset
  2668
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2669
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2670
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2671
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2672
48194c26a46c Initial revision
claus
parents:
diff changeset
  2673
    (cornerRule notNil) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2674
        newCorner := cornerRule value
48194c26a46c Initial revision
claus
parents:
diff changeset
  2675
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2676
        (relativeCorner notNil) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2677
            newCorner := self cornerFromRelativeCorner
48194c26a46c Initial revision
claus
parents:
diff changeset
  2678
        ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2679
            (extentRule notNil) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2680
                newExt := extentRule value
48194c26a46c Initial revision
claus
parents:
diff changeset
  2681
            ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2682
                (relativeExtent notNil) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2683
                    newExt := self extentFromRelativeExtent
48194c26a46c Initial revision
claus
parents:
diff changeset
  2684
                ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2685
            ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2686
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2687
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2688
48194c26a46c Initial revision
claus
parents:
diff changeset
  2689
    newOrg notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2690
        ((newOrg x == oldLeft) and:[newOrg y == oldTop]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2691
            newOrg := nil
48194c26a46c Initial revision
claus
parents:
diff changeset
  2692
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2693
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2694
    newCorner notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2695
        (newCorner = self corner) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2696
            newCorner := nil
48194c26a46c Initial revision
claus
parents:
diff changeset
  2697
        ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2698
            self corner isNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2699
                newExt notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2700
                    ((newExt x == oldWidth) and:[newExt y == oldHeight]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2701
                        newExt := nil
48194c26a46c Initial revision
claus
parents:
diff changeset
  2702
                    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2703
                ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2704
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2705
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2706
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2707
48194c26a46c Initial revision
claus
parents:
diff changeset
  2708
    newCorner isNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2709
        newExt isNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2710
            newOrg notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2711
                self pixelOrigin:newOrg
48194c26a46c Initial revision
claus
parents:
diff changeset
  2712
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2713
        ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2714
            newOrg isNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2715
                self pixelExtent:newExt
48194c26a46c Initial revision
claus
parents:
diff changeset
  2716
            ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2717
                self pixelOrigin:newOrg extent:newExt
48194c26a46c Initial revision
claus
parents:
diff changeset
  2718
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2719
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2720
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2721
        newOrg isNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2722
            self pixelCorner:newCorner
48194c26a46c Initial revision
claus
parents:
diff changeset
  2723
        ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2724
            self pixelOrigin:newOrg corner:newCorner
48194c26a46c Initial revision
claus
parents:
diff changeset
  2725
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2726
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2727
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2728
48194c26a46c Initial revision
claus
parents:
diff changeset
  2729
configureX:x y:y width:newWidth height:newHeight
48194c26a46c Initial revision
claus
parents:
diff changeset
  2730
    "my size has changed by window manager action"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2731
48194c26a46c Initial revision
claus
parents:
diff changeset
  2732
    |how anyEdge mustRedrawBottomEdge mustRedrawRightEdge|
48194c26a46c Initial revision
claus
parents:
diff changeset
  2733
48194c26a46c Initial revision
claus
parents:
diff changeset
  2734
    left := x.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2735
    top := y.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2736
    ((width ~~ newWidth) or:[height ~~ newHeight]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2737
        realized ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2738
            width := newWidth.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2739
            height := newHeight.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2740
            extentChanged := true.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2741
            ^ self
48194c26a46c Initial revision
claus
parents:
diff changeset
  2742
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2743
48194c26a46c Initial revision
claus
parents:
diff changeset
  2744
        ((newWidth <= width) and:[newHeight <= height]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2745
            how := #smaller
48194c26a46c Initial revision
claus
parents:
diff changeset
  2746
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2747
48194c26a46c Initial revision
claus
parents:
diff changeset
  2748
        self is3D ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2749
            mustRedrawBottomEdge := newHeight < height.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2750
            mustRedrawRightEdge := newWidth < width.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2751
            anyEdge := mustRedrawBottomEdge or:[mustRedrawRightEdge]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2752
        ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2753
            anyEdge := false
48194c26a46c Initial revision
claus
parents:
diff changeset
  2754
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2755
48194c26a46c Initial revision
claus
parents:
diff changeset
  2756
        width := newWidth.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2757
        height := newHeight.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2758
48194c26a46c Initial revision
claus
parents:
diff changeset
  2759
        "recompute inner-clip if needed"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2760
        self setInnerClip.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2761
48194c26a46c Initial revision
claus
parents:
diff changeset
  2762
        controller notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2763
            controller sizeChanged:how of:self
48194c26a46c Initial revision
claus
parents:
diff changeset
  2764
        ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2765
            self sizeChanged:how
48194c26a46c Initial revision
claus
parents:
diff changeset
  2766
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2767
48194c26a46c Initial revision
claus
parents:
diff changeset
  2768
        anyEdge ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2769
            self clipRect:nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2770
            mustRedrawBottomEdge ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2771
                self drawBottomEdge
48194c26a46c Initial revision
claus
parents:
diff changeset
  2772
            ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2773
            mustRedrawRightEdge ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2774
                self drawRightEdge
48194c26a46c Initial revision
claus
parents:
diff changeset
  2775
            ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2776
            self clipRect:innerClipRect
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
48194c26a46c Initial revision
claus
parents:
diff changeset
  2781
mapped
48194c26a46c Initial revision
claus
parents:
diff changeset
  2782
    "the view has been mapped (by some outside
48194c26a46c Initial revision
claus
parents:
diff changeset
  2783
     action - i.e. window manager de-iconified me)"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2784
48194c26a46c Initial revision
claus
parents:
diff changeset
  2785
    realized := true.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2786
    shown := true
48194c26a46c Initial revision
claus
parents:
diff changeset
  2787
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2788
48194c26a46c Initial revision
claus
parents:
diff changeset
  2789
unmapped
48194c26a46c Initial revision
claus
parents:
diff changeset
  2790
    "the view has been unmapped (by some outside
48194c26a46c Initial revision
claus
parents:
diff changeset
  2791
     action - i.e. window manager iconified me)"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2792
48194c26a46c Initial revision
claus
parents:
diff changeset
  2793
    shown := false
48194c26a46c Initial revision
claus
parents:
diff changeset
  2794
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2795
48194c26a46c Initial revision
claus
parents:
diff changeset
  2796
exposeX:x y:y width:w height:h
48194c26a46c Initial revision
claus
parents:
diff changeset
  2797
    "a low level redraw event from device
48194c26a46c Initial revision
claus
parents:
diff changeset
  2798
      - let subclass handle the redraw and take care of edges here"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2799
48194c26a46c Initial revision
claus
parents:
diff changeset
  2800
    |leftEdge topEdge rightEdge botEdge anyEdge nx ny nw nh|
48194c26a46c Initial revision
claus
parents:
diff changeset
  2801
48194c26a46c Initial revision
claus
parents:
diff changeset
  2802
    nw := w.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2803
    nh := h.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2804
    nx := x.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2805
    ny := y.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2806
48194c26a46c Initial revision
claus
parents:
diff changeset
  2807
    anyEdge := false.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2808
48194c26a46c Initial revision
claus
parents:
diff changeset
  2809
    "check if there is a need to draw an edge"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2810
48194c26a46c Initial revision
claus
parents:
diff changeset
  2811
    (margin ~~ 0) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2812
        leftEdge := false.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2813
        topEdge := false.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2814
        rightEdge := false.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2815
        botEdge := false.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2816
        (x < margin) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2817
            nx := margin.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2818
            nw := nw - (nx - x).
48194c26a46c Initial revision
claus
parents:
diff changeset
  2819
            leftEdge := true.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2820
            anyEdge := true
48194c26a46c Initial revision
claus
parents:
diff changeset
  2821
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2822
        ((x + w - 1) >= (width - margin)) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2823
            nw := (width - margin - nx).
48194c26a46c Initial revision
claus
parents:
diff changeset
  2824
            rightEdge := true.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2825
            anyEdge := true
48194c26a46c Initial revision
claus
parents:
diff changeset
  2826
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2827
        (y < margin) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2828
            ny := margin.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2829
            nh := nh - (ny - y).
48194c26a46c Initial revision
claus
parents:
diff changeset
  2830
            topEdge := true.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2831
            anyEdge := true
48194c26a46c Initial revision
claus
parents:
diff changeset
  2832
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2833
        ((y + h - 1) >= (height - margin)) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2834
            nh := (height - margin - ny).
48194c26a46c Initial revision
claus
parents:
diff changeset
  2835
            botEdge := true.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2836
            anyEdge := true
48194c26a46c Initial revision
claus
parents:
diff changeset
  2837
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2838
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2839
48194c26a46c Initial revision
claus
parents:
diff changeset
  2840
    "redraw inside area"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2841
48194c26a46c Initial revision
claus
parents:
diff changeset
  2842
    self redrawX:nx y:ny width:nw height:nh.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2843
48194c26a46c Initial revision
claus
parents:
diff changeset
  2844
    "redraw edge(s)"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2845
48194c26a46c Initial revision
claus
parents:
diff changeset
  2846
    anyEdge ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2847
        self clipRect:nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2848
        (topEdge and:[leftEdge and:[botEdge and:[rightEdge]]]) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2849
            self drawEdgesForX:0 y:0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2850
                         width:width height:height
48194c26a46c Initial revision
claus
parents:
diff changeset
  2851
                         level:level
48194c26a46c Initial revision
claus
parents:
diff changeset
  2852
        ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2853
            topEdge ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2854
                self drawTopEdge
48194c26a46c Initial revision
claus
parents:
diff changeset
  2855
            ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2856
            leftEdge ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2857
                self drawLeftEdge
48194c26a46c Initial revision
claus
parents:
diff changeset
  2858
            ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2859
            botEdge ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2860
                self drawBottomEdge
48194c26a46c Initial revision
claus
parents:
diff changeset
  2861
            ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2862
            rightEdge ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2863
                self drawRightEdge
48194c26a46c Initial revision
claus
parents:
diff changeset
  2864
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2865
        ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2866
        self clipRect:innerClipRect
48194c26a46c Initial revision
claus
parents:
diff changeset
  2867
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2868
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2869
48194c26a46c Initial revision
claus
parents:
diff changeset
  2870
keyPress:key x:x y:y
48194c26a46c Initial revision
claus
parents:
diff changeset
  2871
    "a key has been pressed.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2872
     if there is a keyboardHandler, pass input to him"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2873
48194c26a46c Initial revision
claus
parents:
diff changeset
  2874
    "allow forwarding events to the keyboardhandler"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2875
    keyboardHandler notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2876
        keyboardHandler keyPress:key x:x y:y
48194c26a46c Initial revision
claus
parents:
diff changeset
  2877
    ] ifFalse:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2878
        super keyPress:key x:x y:y
48194c26a46c Initial revision
claus
parents:
diff changeset
  2879
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2880
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2881
48194c26a46c Initial revision
claus
parents:
diff changeset
  2882
buttonPress:button x:x y:y
48194c26a46c Initial revision
claus
parents:
diff changeset
  2883
    "button was pressed - if its middle button and there is a menu, show it."
48194c26a46c Initial revision
claus
parents:
diff changeset
  2884
48194c26a46c Initial revision
claus
parents:
diff changeset
  2885
    |menu menuSelector|
48194c26a46c Initial revision
claus
parents:
diff changeset
  2886
48194c26a46c Initial revision
claus
parents:
diff changeset
  2887
    (button == 2) ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2888
        "try ST-80 style menus first"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2889
        model notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2890
            menuSymbol notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2891
                menu := model perform:menuSymbol.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2892
                menu notNil ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2893
                    menuSelector := menu startUp.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2894
                    menuSelector ~~ 0 ifTrue:[
48194c26a46c Initial revision
claus
parents:
diff changeset
  2895
                        model perform:menuSelector
48194c26a46c Initial revision
claus
parents:
diff changeset
  2896
                    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2897
                ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2898
                ^ self
48194c26a46c Initial revision
claus
parents:
diff changeset
  2899
            ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2900
        ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2901
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2902
    super buttonPress:button x:x y:y
48194c26a46c Initial revision
claus
parents:
diff changeset
  2903
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2904
48194c26a46c Initial revision
claus
parents:
diff changeset
  2905
waitForExpose
48194c26a46c Initial revision
claus
parents:
diff changeset
  2906
    "after a scroll, we have to wait for expose/noexpose"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2907
48194c26a46c Initial revision
claus
parents:
diff changeset
  2908
    device dispatchExposeEventsFor:drawableId
48194c26a46c Initial revision
claus
parents:
diff changeset
  2909
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2910
48194c26a46c Initial revision
claus
parents:
diff changeset
  2911
terminate
48194c26a46c Initial revision
claus
parents:
diff changeset
  2912
    "window manager wants me to go away"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2913
48194c26a46c Initial revision
claus
parents:
diff changeset
  2914
    ^ self destroy
48194c26a46c Initial revision
claus
parents:
diff changeset
  2915
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2916
48194c26a46c Initial revision
claus
parents:
diff changeset
  2917
saveAndTerminate
48194c26a46c Initial revision
claus
parents:
diff changeset
  2918
    "window manager wants me to save and go away"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2919
48194c26a46c Initial revision
claus
parents:
diff changeset
  2920
    ^ self destroy
48194c26a46c Initial revision
claus
parents:
diff changeset
  2921
! !