ObjectView.st
author claus
Wed, 21 Dec 1994 20:19:42 +0100
changeset 71 9fd1c36af7a8
parent 70 14443a9ea4ec
child 77 565b052f5277
permissions -rw-r--r--
last version before big scrolling change
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     1
"
5
claus
parents: 3
diff changeset
     2
 COPYRIGHT (c) 1989 by Claus Gittinger
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
     3
	      All Rights Reserved
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     4
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    11
"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    12
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    13
'From Smalltalk/X, Version:2.10.4 on 30-nov-1994 at 3:38:24 pm'!
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
    14
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    15
View subclass:#ObjectView
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
    16
	 instanceVariableNames:'contents sorted lastButt lastPointer lastButtonTime pressAction
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
    17
		releaseAction shiftPressAction doublePressAction motionAction
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    18
		keyPressAction selection gridShown gridPixmap scaleMetric
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    19
		dragObject leftHandCursor readCursor oldCursor movedObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    20
		moveStartPoint moveDelta buffer documentFormat canDragOutOfView
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    21
		rootMotion rootView aligning gridAlign'
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
    22
	 classVariableNames:''
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
    23
	 poolDictionaries:''
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
    24
	 category:'Views-Basic'
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    25
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    26
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    27
ObjectView comment:'
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    28
COPYRIGHT (c) 1989 by Claus Gittinger
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    29
	     All Rights Reserved
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    30
'!
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    31
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    32
!ObjectView class methodsFor:'documentation'!
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    33
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    34
copyright
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    35
"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    36
 COPYRIGHT (c) 1989 by Claus Gittinger
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    37
	      All Rights Reserved
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    38
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    39
 This software is furnished under a license and may be used
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    40
 only in accordance with the terms of that license and with the
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    41
 inclusion of the above copyright notice.   This software may not
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    42
 be provided or otherwise made available to, or used by, any
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    43
 other person.  No title to or ownership of the software is
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    44
 hereby transferred.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    45
"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    46
!
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    47
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    48
version
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    49
"
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    50
$Header: /cvs/stx/stx/libwidg/ObjectView.st,v 1.17 1994-12-21 19:19:42 claus Exp $
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    51
"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    52
!
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    53
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    54
documentation
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    55
"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    56
    a View which can hold DisplayObjects, can make selections, move them around etc.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    57
    this is an abstract class providing common mechanisms - actual instances are
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    58
    DrawView, DirectoryView, LogicView or DocumentView.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    60
    written spring/summer 89 by claus
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    61
"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    62
! !
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    63
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    64
!ObjectView class methodsFor:'defaults'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    65
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    66
hitDelta
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    67
    "when clicking an object, allow for hitDelta pixels around object;
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    68
     0 is exact; 1*pixelPerMillimeter is good for draw programs"
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
    69
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    70
    ^ 0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    71
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    72
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    73
!ObjectView methodsFor:'scrolling'!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    74
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    75
viewOrigin
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    76
    transformation isNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    77
	^ 0@0
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    78
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    79
    ^ transformation translation negated
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    80
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    81
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    82
setViewOrigin:aPoint
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    83
    |p|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    84
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    85
    p := aPoint negated.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    86
    transformation isNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    87
	transformation := WindowingTransformation scale:1 translation:p 
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    88
    ] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    89
	transformation translation:p 
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    90
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    91
"/    clipRect notNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    92
"/        self computeInnerClip.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    93
"/    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    94
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    95
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    96
scrollDown:nPixels
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    97
    "change origin to scroll down some pixels"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    98
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
    99
    |count "{ Class:SmallInteger }"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   100
     m2    "{ Class:SmallInteger }"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   101
     w     "{ Class:SmallInteger }"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   102
     h     "{ Class:SmallInteger }"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   103
     hCont "{ Class:SmallInteger }"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   104
     ih    "{ Class:SmallInteger }"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   105
     orgX orgY|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   106
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   107
    hCont := self heightOfContents.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   108
    transformation isNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   109
	orgY := orgX := 0
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   110
    ] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   111
	orgY := transformation translation y negated.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   112
	orgX := transformation translation x negated.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   113
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   114
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   115
    count := nPixels.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   116
    ih := self innerHeight.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   117
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   118
    ((orgY + nPixels + ih) > hCont) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   119
	count := hCont - orgY - ih
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   120
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   121
    (count <= 0) ifTrue:[^ self].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   122
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   123
    self originWillChange.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   124
    self setViewOrigin:(orgX @ (orgY + count)).
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   125
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   126
    (count >= ih) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   127
	self redraw.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   128
    ] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   129
	m2 := margin * 2.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   130
	h := height - m2 - count.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   131
	w := self width.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   132
	self catchExpose.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   133
	self copyFrom:self x:margin y:(count + margin)
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   134
			 toX:margin y:margin
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   135
		       width:w 
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   136
		      height:h.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   137
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   138
	self setInnerClip.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   139
	self redrawDeviceX:margin y:(h + margin) 
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   140
		     width:(width - m2) height:count.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   141
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   142
	self waitForExpose.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   143
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   144
    self originChanged:(0 @ count).
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   145
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   146
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   147
scrollUp:nPixels
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   148
    "change origin to scroll up (towards the origin) by some pixels"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   149
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   150
    |count "{ Class:SmallInteger }"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   151
     m2    "{ Class:SmallInteger }"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   152
     w     "{ Class:SmallInteger }"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   153
     h     "{ Class:SmallInteger }"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   154
     orgX
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   155
     orgY  "{ Class:SmallInteger }"|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   156
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   157
    transformation isNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   158
	orgY := orgX := 0
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   159
    ] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   160
	orgY := transformation translation y negated.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   161
	orgX := transformation translation x negated
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   162
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   163
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   164
    count := nPixels.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   165
    (count > orgY) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   166
	count := orgY
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   167
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   168
    (count <= 0) ifTrue:[^ self].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   169
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   170
    self originWillChange.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   171
    self setViewOrigin:(orgX @ (orgY - count)).
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   172
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   173
    (count >= self innerHeight) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   174
	self redraw.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   175
    ] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   176
	m2 := margin * 2. "top & bottom margins"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   177
	h := height - m2 - count.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   178
	w := width.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   179
	self catchExpose.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   180
	self copyFrom:self x:margin y:margin
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   181
			 toX:margin y:(count + margin)
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   182
		       width:w height:h.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   183
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   184
	self setInnerClip.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   185
	self redrawDeviceX:margin y:margin
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   186
		     width:(width - m2)
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   187
		    height:count.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   188
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   189
	self waitForExpose.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   190
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   191
    self originChanged:(0 @ count negated).
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   192
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   193
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   194
scrollLeft:nPixels
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   195
    "change origin to scroll left some pixels"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   196
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   197
    |count "{ Class:SmallInteger }"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   198
     m2    "{ Class:SmallInteger }"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   199
     h     "{ Class:SmallInteger }"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   200
     orgX orgY|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   201
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   202
    transformation isNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   203
	orgY := orgX := 0
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   204
    ] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   205
	orgY := transformation translation y negated.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   206
	orgX := transformation translation x negated.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   207
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   208
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   209
    count := nPixels.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   210
    (count > orgX) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   211
	count := orgX
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   212
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   213
    (count <= 0) ifTrue:[^ self].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   214
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   215
    self originWillChange.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   216
    self setViewOrigin:(orgX - count) @ orgY.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   217
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   218
    (count >= self innerWidth) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   219
	self redraw.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   220
    ] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   221
	m2 := margin * 2.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   222
	h := (height - m2).
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   223
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   224
	self catchExpose.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   225
	self copyFrom:self x:margin y:margin
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   226
			 toX:(count + margin) y:margin
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   227
		       width:(width - m2 - count) 
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   228
		      height:h.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   229
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   230
	self setInnerClip.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   231
	self redrawDeviceX:margin y:margin
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   232
		     width:count height:(height - m2).
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   233
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   234
	self waitForExpose.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   235
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   236
    self originChanged:(count negated @ 0).
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   237
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   238
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   239
scrollRight:nPixels
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   240
    "change origin to scroll right some pixels"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   241
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   242
    |count "{ Class:SmallInteger }"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   243
     m2    "{ Class:SmallInteger }"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   244
     h     "{ Class:SmallInteger }" 
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   245
     wCont "{ Class:SmallInteger }"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   246
     iw    "{ Class:SmallInteger }"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   247
     orgX orgY|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   248
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   249
    wCont := self widthOfContents.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   250
    transformation isNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   251
	orgY := orgX := 0
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   252
    ] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   253
	orgY := transformation translation y negated.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   254
	orgX := transformation translation x negated.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   255
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   256
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   257
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   258
    count := nPixels.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   259
    iw := self innerWidth.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   260
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   261
    ((orgX + nPixels + iw) > wCont) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   262
	count := wCont - orgX - iw
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   263
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   264
    (count <= 0) ifTrue:[^ self].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   265
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   266
    self originWillChange.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   267
    self setViewOrigin:(orgX + count) @ orgY.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   268
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   269
    (count >= iw) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   270
	self redraw.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   271
    ] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   272
	m2 := margin * 2.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   273
	h := (height - m2).
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   274
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   275
	self catchExpose.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   276
	self copyFrom:self x:(count + margin) y:margin
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   277
			 toX:margin y:margin
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   278
		       width:(width - m2 - count) 
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   279
		      height:h.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   280
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   281
	self setInnerClip.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   282
	self redrawDeviceX:(width - margin - count) y:margin 
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   283
		     width:count height:(height - m2).
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   284
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   285
	self waitForExpose.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   286
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   287
    self originChanged:(count @ 0).
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   288
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   289
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   290
verticalScrollStep
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   291
    "return the amount to scroll when stepping left/right."
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   292
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   293
    scaleMetric == #inch ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   294
	^ (device verticalPixelPerInch * (1/2)) asInteger
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   295
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   296
    ^ (device verticalPixelPerMillimeter * 20) asInteger
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   297
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   298
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   299
horizontalScrollStep
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   300
    "return the amount to scroll when stepping left/right."
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   301
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   302
    scaleMetric == #inch ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   303
	^ (device horizontalPixelPerInch * (1/2)) asInteger
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   304
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   305
    ^ (device horizontalPixelPerMillimeter * 20) asInteger
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   306
! !
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   307
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   308
!ObjectView methodsFor:'misc'!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   309
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   310
objectsIntersecting:aRectangle do:aBlock
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   311
    "do something to every object which intersects a rectangle"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   312
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   313
    |f top bot
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   314
     firstIndex "{ Class: SmallInteger }"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   315
     delta      "{ Class: SmallInteger }"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   316
     theObject 
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   317
     nObjects   "{ Class: SmallInteger }"|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   318
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   319
    nObjects := contents size.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   320
    (nObjects == 0) ifTrue:[^ self].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   321
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   322
    sorted ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   323
	"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   324
	 have to check every object
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   325
	"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   326
	contents do:[:theObject |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   327
	    (theObject frame intersects:aRectangle) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   328
		aBlock value:theObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   329
	    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   330
	].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   331
	^ self
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   332
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   333
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   334
    "
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   335
     contents is sorted by y; can do a fast (binary) search for the first
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   336
     object which intersects aRectangle and 
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   337
     break from the draw loop, when the 1st object below aRectangle is reached.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   338
    "
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   339
    bot := aRectangle bottom.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   340
    top := aRectangle top.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   341
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   342
    "
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   343
     binary search for an object in aRectangle ...
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   344
    "
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   345
    delta := nObjects // 2.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   346
    firstIndex := delta.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   347
    (firstIndex == 0) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   348
       firstIndex := 1
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   349
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   350
    theObject := contents at:firstIndex.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   351
    (theObject frame bottom < top) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   352
	[theObject frame bottom < top and:[delta > 1]] whileTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   353
	    delta := delta // 2.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   354
	    firstIndex := firstIndex + delta.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   355
	    theObject := contents at:firstIndex
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   356
	]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   357
    ] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   358
	[theObject frame top > bot and:[delta > 1]] whileTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   359
	    delta := delta // 2.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   360
	    firstIndex := firstIndex - delta.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   361
	    theObject := contents at:firstIndex
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   362
	]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   363
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   364
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   365
    "
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   366
     now, theObject at:firstIndex is in aRectangle; go backward to the object
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   367
     following first non-visible
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   368
    "
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   369
    [theObject frame bottom > top and:[firstIndex > 1]] whileTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   370
	firstIndex := firstIndex - 1.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   371
	theObject := contents at:firstIndex
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   372
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   373
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   374
    firstIndex to:nObjects do:[:index |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   375
	theObject := contents at:index.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   376
	f := theObject frame.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   377
	(f intersects:aRectangle) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   378
	    aBlock value:theObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   379
	] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   380
	    (f top > bot) ifTrue:[^ self]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   381
	]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   382
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   383
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   384
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   385
forEach:aCollection do:aBlock
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   386
    "apply block to every object in a collectioni;
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   387
     (adds a check for non-collection)"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   388
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   389
    aCollection isNil ifTrue:[^self].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   390
    (aCollection isKindOf:Collection) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   391
	aCollection do:[:object |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   392
	    object notNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   393
		aBlock value:object
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   394
	    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   395
	]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   396
    ] ifFalse: [
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   397
	aBlock value:aCollection
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   398
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   399
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   400
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   401
objectsIntersectingVisible:aRectangle do:aBlock
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   402
    "do something to every object which intersects a visible rectangle"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   403
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   404
    |absRect viewOrigin|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   405
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   406
    viewOrigin := 0@0. "/self viewOrigin.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   407
    absRect := Rectangle left:(aRectangle left + viewOrigin x)
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   408
			  top:(aRectangle top + viewOrigin y)
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   409
			width:(aRectangle width)
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   410
		       height:(aRectangle height).
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   411
    self objectsIntersecting:absRect do:aBlock
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   412
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   413
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   414
setDefaultActions
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   415
    motionAction := [:movePoint | nil].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   416
    releaseAction := [nil]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   417
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   418
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   419
objectsIntersecting:aRectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   420
    "answer a Collection of objects intersecting the argument, aRectangle"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   421
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   422
    |newCollection|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   423
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   424
    newCollection := OrderedCollection new.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   425
    self objectsIntersecting:aRectangle do:[:theObject |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   426
	newCollection add:theObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   427
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   428
    (newCollection size == 0) ifTrue:[^ nil].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   429
    ^ newCollection
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   430
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   431
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   432
setMoveActions
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   433
    motionAction := [:movePoint | self doObjectMove:movePoint].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   434
    releaseAction := [self endObjectMove]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   435
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   436
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   437
setRectangleDragActions
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   438
    motionAction := [:movePoint | self doRectangleDrag:movePoint].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   439
    releaseAction := [self endRectangleDrag]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   440
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   441
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   442
objectsIn:aRectangle do:aBlock
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   443
    "do something to every object which is completely in a rectangle"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   444
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   445
    |bot|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   446
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   447
    sorted ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   448
	bot := aRectangle bottom.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   449
	contents do:[:theObject |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   450
	    (theObject isContainedIn:aRectangle) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   451
		aBlock value:theObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   452
	    ] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   453
		theObject frame top > bot ifTrue:[^ self]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   454
	    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   455
	].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   456
	^ self
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   457
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   458
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   459
    contents do:[:theObject |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   460
	(theObject isContainedIn:aRectangle) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   461
	    aBlock value:theObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   462
	]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   463
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   464
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   465
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   466
documentFormat:aFormatString
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   467
    "set the document format (mostly used by scrollbars).
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   468
     The argument should be a string such as 'a4', 'a5'
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   469
     or 'letter'. See widthOfContentsInMM for supported formats."
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   470
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   471
    aFormatString ~= documentFormat ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   472
	documentFormat := aFormatString.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   473
	self contentsChanged.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   474
	self defineGrid.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   475
	gridShown ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   476
	    self clear.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   477
	    self redraw
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   478
	]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   479
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   480
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   481
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   482
setLineDragActions
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   483
    motionAction := [:movePoint | self doLineDrag:movePoint].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   484
    releaseAction := [self endLineDrag]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   485
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   486
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   487
objectsInVisible:aRectangle do:aBlock
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   488
    "do something to every object which is completely in a 
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   489
     visible rectangle"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   490
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   491
    |absRect viewOrigin|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   492
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   493
    viewOrigin := 0@0. "/self viewOrigin.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   494
    absRect := Rectangle left:(aRectangle left + viewOrigin x)
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   495
			  top:(aRectangle top + viewOrigin y)
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   496
			width:(aRectangle width)
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   497
		       height:(aRectangle height).
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   498
    self objectsIn:absRect do:aBlock
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   499
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   500
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   501
visibleObjectsDo:aBlock
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   502
    "do something to every visible object"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   503
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   504
    |absRect viewOrigin|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   505
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   506
    viewOrigin := 0@0. "/self viewOrigin.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   507
    absRect := Rectangle left:viewOrigin x
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   508
			  top:viewOrigin y
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   509
			width:width
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   510
		       height:height.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   511
    self objectsIntersecting:absRect do:aBlock
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   512
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   513
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   514
numberOfObjectsIntersectingVisible:aRectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   515
    "answer the number of objects intersecting the argument, aRectangle"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   516
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   517
    |absRect viewOrigin|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   518
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   519
    viewOrigin := 0@0. "/self viewOrigin.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   520
    absRect := Rectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   521
		 left:(aRectangle left + viewOrigin x)
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   522
		  top:(aRectangle top  + viewOrigin y)
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   523
		width:(aRectangle width)
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   524
	       height:(aRectangle height).
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   525
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   526
    ^ self numberOfObjectsIntersecting:aRectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   527
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   528
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   529
numberOfObjectsIntersecting:aRectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   530
    "answer the number of objects intersecting the argument, aRectangle"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   531
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   532
    |tally|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   533
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   534
    tally := 0.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   535
    contents do:[:theObject |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   536
	(theObject frame intersects:aRectangle) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   537
	    tally := tally + 1
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   538
	]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   539
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   540
    ^ tally
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   541
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   542
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   543
objectsIntersectingVisible:aRectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   544
    "answer a Collection of objects intersecting a visible aRectangle"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   545
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   546
    |absRect viewOrigin|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   547
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   548
    viewOrigin := 0@0. "/self viewOrigin.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   549
    absRect := Rectangle left:(aRectangle left + viewOrigin x)
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   550
			  top:(aRectangle top + viewOrigin y)
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   551
			width:(aRectangle width)
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   552
		       height:(aRectangle height).
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   553
    ^ self objectsIntersecting:absRect
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   554
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   555
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   556
objectsBelow:objectToBeTested do:aBlock
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   557
    "do something to every object below objectToBeTested
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   558
     (does not mean obscured by - simply below in hierarchy)"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   559
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   560
    |endIndex|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   561
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   562
    endIndex := contents identityIndexOf:objectToBeTested ifAbsent:[self error].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   563
    contents from:1 to:(endIndex - 1) do:aBlock
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   564
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   565
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   566
objectsAbove:objectToBeTested do:aBlock
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   567
    "do something to every object above objectToBeTested
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   568
     (does not mean obscured - simply above in hierarchy)"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   569
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   570
    |startIndex|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   571
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   572
    startIndex := contents identityIndexOf:objectToBeTested
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   573
				  ifAbsent:[self error].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   574
    contents from:startIndex to:(contents size) do:aBlock
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   575
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   576
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   577
objectsAbove:anObject intersecting:aRectangle do:aBlock
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   578
    "do something to every object above objectToBeTested
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   579
     and intersecting aRectangle"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   580
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   581
    self objectsAbove:anObject do:[:theObject |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   582
	(theObject frame intersects:aRectangle) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   583
	    aBlock value:theObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   584
	]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   585
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   586
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   587
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   588
rectangleForScroll
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   589
    "find the area occupied by visible objects"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   590
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   591
    |left right top bottom frame oLeft oRight oTop oBottom orgX orgY viewOrigin|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   592
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   593
    viewOrigin := 0@0. "/self viewOrigin.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   594
    orgX := 0 . "/viewOrigin x.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   595
    orgY := 0 . "/viewOrigin y.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   596
    left := 9999.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   597
    right := 0.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   598
    top := 9999.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   599
    bottom := 0.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   600
    self visibleObjectsDo:[:anObject |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   601
	frame := anObject frame.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   602
	oLeft := frame left - orgX.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   603
	oRight := frame right - orgX.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   604
	oTop := frame top - orgY.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   605
	oBottom := frame bottom - orgY.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   606
	(oLeft < left) ifTrue:[left := oLeft].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   607
	(oRight > right) ifTrue:[right := oRight].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   608
	(oTop < top) ifTrue:[top := oTop].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   609
	(oBottom > bottom) ifTrue:[bottom := oBottom]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   610
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   611
    (left < margin) ifTrue:[left := margin].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   612
    (top < margin) ifTrue:[top := margin].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   613
    (right > (width - margin)) ifTrue:[right := width - margin].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   614
    (bottom > (height - margin)) ifTrue:[bottom := height - margin].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   615
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   616
    ((left > right) or:[top > bottom]) ifTrue:[^ nil].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   617
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   618
    ^ Rectangle left:left right:right top:top bottom:bottom
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   619
! !
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   620
70
14443a9ea4ec *** empty log message ***
claus
parents: 69
diff changeset
   621
!ObjectView methodsFor:'event handling'!
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   622
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   623
redrawX:x y:y width:w height:h
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   624
    |innerX innerY innerW innerH redrawFrame |
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   625
69
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
   626
    ((contents size ~~ 0) or:[gridShown]) ifTrue:[
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
   627
	innerX := x.
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
   628
	innerY := y.
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
   629
	innerW := w.
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
   630
	innerH := h.
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   631
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   632
	redrawFrame := Rectangle left:innerX top:innerY 
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   633
				width:innerW height:innerH.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   634
	self redrawObjectsInVisible:redrawFrame
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   635
    ]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   636
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   637
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   638
redrawDeviceX:x y:y width:w height:h
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   639
super redrawDeviceX:x y:y width:w height:h
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   640
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   641
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   642
buttonPress:button x:x y:y
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   643
    "user pressed left button"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   644
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   645
    ((button == 1) or:[button == #select]) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   646
	pressAction notNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   647
	    lastButt := x @ y.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   648
	    pressAction value:lastButt
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   649
	]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   650
    ] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   651
	super buttonPress:button x:x y:y
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   652
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   653
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   654
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   655
buttonRelease:button x:x y:y
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   656
    ((button == 1) or:[button == #select]) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   657
	releaseAction notNil ifTrue:[releaseAction value]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   658
    ] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   659
	super buttonRelease:button x:x y:y
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   660
    ] 
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   661
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   662
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   663
buttonMotion:buttonMask x:buttX y:buttY
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   664
    "user moved mouse while button pressed"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   665
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   666
    |xpos ypos movePoint limitW limitH|
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   667
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   668
    "is it the select or 1-button ?"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   669
    (device buttonMotionMask:buttonMask includesButton:#select) ifFalse:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   670
	(device buttonMotionMask:buttonMask includesButton:1) ifFalse:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   671
	    ^ self
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   672
	].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   673
    ].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   674
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   675
    lastButt notNil ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   676
	xpos := buttX.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   677
	ypos := buttY.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   678
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   679
	"check against visible limits if move outside is not allowed"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   680
	rootMotion ifFalse:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   681
	    limitW := width.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   682
	    limitH := height.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   683
	    transformation notNil ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   684
		limitW := transformation applyInverseToX:width.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   685
		limitH := transformation applyInverseToY:height.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   686
	    ].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   687
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   688
	    (xpos < 0) ifTrue:[                    
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   689
		xpos := 0
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   690
	    ] ifFalse: [
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   691
		(xpos > limitW) ifTrue:[xpos := limitW]
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   692
	    ].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   693
	    (ypos < 0) ifTrue:[                    
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   694
		ypos := 0
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   695
	    ] ifFalse: [
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   696
		(ypos > limitH) ifTrue:[ypos := limitH]
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   697
	    ]
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   698
	].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   699
	movePoint := xpos @ ypos.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   700
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   701
	(xpos == (lastButt x)) ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   702
	    (ypos == (lastButt y)) ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   703
		^ self                          "no move"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   704
	    ]
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   705
	].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   706
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   707
	motionAction notNil ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   708
	    motionAction value:movePoint
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   709
	].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   710
	lastButt := movePoint
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   711
    ]
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   712
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   713
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   714
buttonMultiPress:button x:x y:y
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   715
    "user pressed left button twice (or more)"
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   716
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   717
    ((button == 1) or:[button == #select]) ifTrue:[
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   718
	doublePressAction notNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   719
	    doublePressAction value:(x @ y)
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   720
	]
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   721
    ] ifFalse:[
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   722
	super buttonMultiPress:button x:x y:y
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   723
    ]
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   724
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   725
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   726
buttonShiftPress:button x:x y:y
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   727
    "user pressed left button with shift"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   728
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   729
    ((button == 1) or:[button == #select]) ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   730
	shiftPressAction notNil ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   731
	    lastButt := x @ y.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   732
	    shiftPressAction value:lastButt
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   733
	]
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   734
    ] ifFalse:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   735
	super buttonShiftPress:button x:x y:y
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   736
    ]
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   737
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   738
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   739
keyPress:key x:x y:y
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   740
    keyPressAction notNil ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   741
	selection notNil ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   742
	    self selectionDo: [:obj |
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   743
		obj keyInput:key
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   744
	    ]
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   745
	]
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
   746
    ]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   747
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   748
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   749
!ObjectView methodsFor:'dragging object move'!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   750
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   751
doObjectMove:aPoint
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   752
    "do an object move.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   753
     moveStartPoint is the original click-point.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   754
     moveDelta"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   755
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   756
    |dragger offset d p|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   757
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   758
    rootMotion ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   759
	dragger := rootView.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   760
	offset := 0@0 "self viewOrigin".
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   761
    ] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   762
	dragger := self.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   763
	offset := 0@0.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   764
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   765
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   766
    "
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   767
     when drawing in the root window, we have to use its coordinates
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   768
     this is kept in offset.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   769
    "
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   770
    movedObject isNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   771
	movedObject := selection.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   772
	"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   773
	 draw first outline
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   774
	"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   775
	movedObject notNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   776
	    moveDelta := 0@0.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   777
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   778
	    dragger xoring:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   779
		"tricky, the moved object may not currently be aligned.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   780
		 if so, simulate a frame move of the delta"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   781
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   782
		aligning ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   783
		    d := movedObject origin 
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   784
			 - (self alignToGrid:(movedObject origin)).
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   785
"/ d printNL.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   786
		    moveDelta := d negated.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   787
		].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   788
"/ moveDelta printNL.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   789
		self showDragging:movedObject offset:moveDelta - offset.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   790
	    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   791
	]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   792
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   793
    movedObject notNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   794
	"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   795
	 clear prev outline,
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   796
	 draw new outline
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   797
	"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   798
	dragger xoring:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   799
	    self showDragging:movedObject offset:moveDelta - offset.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   800
	    moveDelta := aPoint - moveStartPoint.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   801
	    aligning ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   802
		moveDelta := self alignToGrid:moveDelta
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   803
	    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   804
	    self showDragging:movedObject offset:moveDelta - offset.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   805
	]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   806
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   807
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   808
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   809
endObjectMove
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   810
    "cleanup after object move - find the destination view and dispatch to
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   811
     one of the moveObjectXXX-methods. These can be redefined in subclasses."
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   812
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   813
    |dragger inMySelf offs2 rootPoint destinationPoint
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   814
     viewId destinationView destinationId lastViewId|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   815
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   816
    movedObject notNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   817
	rootMotion ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   818
	    dragger := rootView.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   819
	    offs2 := 0@0 "self viewOrigin"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   820
	] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   821
	    dragger := self.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   822
	    offs2 := 0@0
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   823
	].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   824
	dragger xoring:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   825
	    self showDragging:movedObject offset:moveDelta - offs2
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   826
	].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   827
	dragger device synchronizeOutput.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   828
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   829
	"check if object is to be put into another view"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   830
	rootMotion ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   831
	    rootPoint := device translatePoint:lastButt
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   832
					  from:(self id) 
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   833
					    to:(rootView id).
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   834
	    "search view the drop is in"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   835
	    viewId := rootView id.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   836
	    [viewId notNil] whileTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   837
		destinationId := device viewIdFromPoint:rootPoint in:viewId.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   838
		lastViewId := viewId.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   839
		viewId := destinationId
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   840
	    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   841
	    destinationView := device viewFromId:lastViewId.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   842
	    destinationId := lastViewId.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   843
	    inMySelf := (destinationView == self).
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   844
	    rootMotion := false
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   845
	] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   846
	    inMySelf := true
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   847
	].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   848
	inMySelf ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   849
	    "simple move"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   850
	    self move:movedObject by:moveDelta
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   851
	] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   852
	    destinationPoint := device translatePoint:rootPoint
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   853
						 from:(rootView id) 
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   854
						   to:destinationId.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   855
	    destinationView notNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   856
		"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   857
		 move into another smalltalk view
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   858
		"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   859
		self move:movedObject to:destinationPoint in:destinationView
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   860
	    ] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   861
		"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   862
		 not one of my views
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   863
		"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   864
		self move:movedObject to:destinationPoint inAlienViewId:destinationId
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   865
	    ] 
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   866
	].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   867
	self setDefaultActions.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   868
	movedObject := nil
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   869
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   870
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   871
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   872
startObjectMove:something at:aPoint
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   873
    "start an object move"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   874
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   875
    something notNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   876
	self select:something.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   877
	(self canMove:something) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   878
	    self setMoveActions.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   879
	    moveStartPoint := aPoint.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   880
	    rootMotion := canDragOutOfView.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   881
	    "self doObjectMove:aPoint "
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   882
	] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   883
	    self setDefaultActions
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   884
	]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   885
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   886
! !
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   887
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   888
!ObjectView methodsFor:'drawing'!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   889
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   890
redrawObjectsIntersecting:aRectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   891
    "redraw all objects which have part of themself in aRectangle"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   892
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   893
    self objectsIntersecting:aRectangle do:[:theObject |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   894
	self show:theObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   895
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   896
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   897
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   898
showDragging:something offset:anOffset
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   899
    "show an object while dragging"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   900
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   901
    |drawOffset top drawer|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   902
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   903
    rootMotion ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   904
	"drag in root-window"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   905
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   906
	top := self topView.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   907
	drawOffset := device translatePoint:anOffset
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   908
				       from:(self id) to:(rootView id).
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   909
	drawer := rootView
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   910
    ] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   911
	drawOffset := anOffset.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   912
	drawer := self
65
b33e4f3a264e *** empty log message ***
claus
parents: 63
diff changeset
   913
    ].
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   914
    self forEach:something do:[:anObject |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   915
	anObject drawDragIn:drawer offset:drawOffset
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   916
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   917
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   918
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   919
redrawObjectsIntersectingVisible:aRectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   920
    "redraw all objects which have part of themself in a vis rectangle"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   921
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   922
    self objectsIntersectingVisible:aRectangle do:[:theObject |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   923
	self show:theObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   924
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   925
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   926
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   927
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   928
redrawObjectsInVisible:visRect
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   929
    "redraw all objects which have part of themselfes in a vis rectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   930
     draw only in (i.e. clip output to) aRectangle"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   931
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   932
    |vis|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   933
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   934
    shown ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   935
	vis := visRect.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   936
	clipRect notNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   937
	    vis := vis intersect:clipRect
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   938
	].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   939
	transformation notNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   940
	    vis := vis origin truncated
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   941
		       corner:(vis corner + (1@1)) truncated.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   942
	].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   943
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   944
	self clippedTo:vis do:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   945
	    self clearRectangle:vis.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   946
	    self redrawObjectsIntersectingVisible:vis
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   947
	]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   948
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   949
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   950
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   951
redraw
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   952
    "redraw complete View"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   953
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   954
    shown ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   955
	self clear.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   956
	self redrawObjects
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   957
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   958
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   959
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   960
redrawObjectsOn:aGC
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   961
    "redraw all objects on a graphic context"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   962
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   963
    |vFrame org viewOrigin|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   964
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   965
    (aGC == self) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   966
	shown ifFalse:[^ self].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   967
	viewOrigin := 0@0. "/self viewOrigin.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   968
	org := viewOrigin.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   969
	vFrame := Rectangle origin:org
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   970
			    corner:(viewOrigin + (width @ height)).
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   971
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   972
	transformation notNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   973
	    vFrame := transformation applyInverseTo:vFrame.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   974
	].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   975
	self redrawObjectsIntersecting:vFrame
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   976
    ] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   977
	"loop over pages"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   978
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   979
"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   980
	org := 0 @ 0.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   981
	vFrame := Rectangle origin:org
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   982
			    corner:(org + (width @ height)).
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   983
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   984
	self redrawObjectsIntersecting:vFrame
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   985
"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   986
	self objectsIntersecting:vFrame do:[:theObject |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   987
	    theObject drawIn:aGC
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   988
	]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   989
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   990
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   991
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   992
redrawObjects
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   993
    "redraw all objects"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   994
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   995
    self redrawObjectsOn:self
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   996
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   997
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   998
show:anObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
   999
    "show the object, either selected or not"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1000
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1001
    (self isSelected:anObject) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1002
	self showSelected:anObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1003
    ] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1004
	self showUnselected:anObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1005
    ]
65
b33e4f3a264e *** empty log message ***
claus
parents: 63
diff changeset
  1006
!
b33e4f3a264e *** empty log message ***
claus
parents: 63
diff changeset
  1007
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1008
showUnselected:anObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1009
    "show an object as unselected"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1010
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1011
    anObject drawIn:self
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1012
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1013
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1014
redrawObjectsIn:aRectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1015
    "redraw all objects which have part of themselfes in aRectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1016
     draw only in (i.e. clip output to) aRectangle"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1017
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1018
    |visRect viewOrigin|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1019
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1020
    shown ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1021
	viewOrigin := 0@0. "/self viewOrigin.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1022
	visRect := Rectangle origin:(aRectangle origin - viewOrigin)
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1023
			     extent:(aRectangle extent).
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1024
	transformation notNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1025
	    visRect := visRect origin truncated
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1026
		       corner:(visRect corner + (1@1)) truncated.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1027
	].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1028
	clipRect notNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1029
	    visRect := visRect intersect:clipRect
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1030
	].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1031
"/        transformation notNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1032
"/            visRect := visRect origin truncated
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1033
"/                       corner:(visRect corner + (1@1)) truncated.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1034
"/        ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1035
	self clippedTo:visRect do:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1036
	    self clearRectangle:visRect.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1037
	    self redrawObjectsIntersecting:visRect "/ aRectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1038
	]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1039
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1040
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1041
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1042
redrawScale
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1043
    "redraw the scales"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1044
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1045
    self redrawHorizontalScale.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1046
    self redrawVerticalScale
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1047
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1048
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1049
redrawObjectsAbove:anObject intersecting:aRectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1050
    "redraw all objects which have part of themself in aRectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1051
     and are above (in front of) anObject"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1052
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1053
    self objectsAbove:anObject intersecting:aRectangle do:[:theObject |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1054
	self show:theObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1055
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1056
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1057
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1058
redrawObjectsAbove:anObject intersectingVisible:aRectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1059
    "redraw all objects which have part of themself in a vis rectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1060
     and are above (in front of) anObject"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1061
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1062
    self objectsAbove:anObject intersectingVisible:aRectangle do:[:theObject |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1063
	self show:theObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1064
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1065
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1066
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1067
showSelected:anObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1068
    "show an object as selected"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1069
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1070
    anObject drawSelectedIn:self
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1071
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1072
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1073
redrawObjectsAbove:anObject in:aRectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1074
    "redraw all objects which have part of themselfes in aRectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1075
     and are above (in front of) anObject.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1076
     draw only in (i.e. clip output to) aRectangle"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1077
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1078
    |vis|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1079
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1080
    shown ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1081
	vis := aRectangle.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1082
	clipRect notNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1083
	    vis := vis intersect:clipRect
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1084
	].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1085
	self clippedTo:vis do:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1086
	    self redrawObjectsAbove:anObject intersecting:vis
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1087
	]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1088
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1089
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1090
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1091
redrawObjectsAbove:anObject inVisible:aRectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1092
    "redraw all objects which have part of themselfes in a vis rectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1093
     and are above (in front of) anObject.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1094
     draw only in (i.e. clip output to) aRectangle"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1095
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1096
    |vis|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1097
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1098
    shown ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1099
	vis := aRectangle.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1100
	clipRect notNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1101
	    vis := vis intersect:clipRect
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1102
	].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1103
	self clippedTo:vis do:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1104
	    self redrawObjectsAbove:anObject intersectingVisible:vis
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1105
	]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1106
    ]
65
b33e4f3a264e *** empty log message ***
claus
parents: 63
diff changeset
  1107
! !
b33e4f3a264e *** empty log message ***
claus
parents: 63
diff changeset
  1108
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1109
!ObjectView methodsFor:'queries'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1110
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1111
heightOfContents
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1112
    "answer the height of the document in pixels"
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1113
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1114
    |h|
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1115
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1116
    h := self heightOfContentsInMM * (self verticalPixelPerMillimeter:1).
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1117
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1118
    transformation isNil ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1119
	^ h rounded
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1120
    ].
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1121
    ^ (transformation applyScaleY:h) rounded 
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1122
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1123
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1124
widthOfContents
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1125
    "answer the width of the document in pixels"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1126
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1127
    |w|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1128
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1129
    w := self widthOfContentsInMM * (self horizontalPixelPerMillimeter:1).
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1130
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1131
    transformation isNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1132
	^ w rounded
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1133
    ].
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1134
    ^ (transformation applyScaleX:w) rounded
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1135
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1136
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1137
heightOfContentsInMM
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1138
    "answer the height of the document in millimeters"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1139
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1140
    "landscape"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1141
    (documentFormat = 'a1l') ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1142
	^ 592
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1143
    ].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1144
    (documentFormat = 'a2l') ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1145
	^ 420
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1146
    ].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1147
    (documentFormat = 'a3l') ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1148
	^ 296
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1149
    ].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1150
    (documentFormat = 'a4l') ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1151
	^ 210
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1152
    ].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1153
    (documentFormat = 'a5l') ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1154
	^ 148
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1155
    ].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1156
    (documentFormat = 'a6l') ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1157
	^ 105
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1158
    ].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1159
    (documentFormat = 'letterl') ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1160
	^ 8.5 * 25.4
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1161
    ].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1162
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1163
    (documentFormat = 'a1') ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1164
	^ 840
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1165
    ].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1166
    (documentFormat = 'a2') ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1167
	^ 592
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1168
    ].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1169
    (documentFormat = 'a3') ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1170
	^ 420
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1171
    ].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1172
    (documentFormat = 'a4') ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1173
	^ 296
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1174
    ].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1175
    (documentFormat = 'a5') ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1176
	^ 210
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1177
    ].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1178
    (documentFormat = 'a6') ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1179
	^ 148
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1180
    ].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1181
    (documentFormat = 'letter') ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1182
	^ 11 * 25.4
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1183
    ].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1184
    "*** more formats needed here ...***"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1185
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1186
    "assuming window size is document size"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1187
    ^ (height / self verticalPixelPerMillimeter:1) asInteger
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1188
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1189
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1190
widthOfContentsInMM
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1191
    "answer the width of the document in millimeters"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1192
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1193
    "landscape"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1194
    (documentFormat = 'a1l') ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1195
	^ 840
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1196
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1197
    (documentFormat = 'a2l') ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1198
	^ 592
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1199
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1200
    (documentFormat = 'a3l') ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1201
	^ 420
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1202
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1203
    (documentFormat = 'a4l') ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1204
	^ 296
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1205
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1206
    (documentFormat = 'a5l') ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1207
	^ 210
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1208
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1209
    (documentFormat = 'a6l') ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1210
	^ 148
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1211
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1212
    (documentFormat = 'letterl') ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1213
	^ 11 * 25.4
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1214
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1215
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1216
    (documentFormat = 'a1') ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1217
	^ 592
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1218
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1219
    (documentFormat = 'a2') ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1220
	^ 420
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1221
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1222
    (documentFormat = 'a3') ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1223
	^ 296
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1224
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1225
    (documentFormat = 'a4') ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1226
	^ 210
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1227
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1228
    (documentFormat = 'a5') ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1229
	^ 148
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1230
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1231
    (documentFormat = 'a6') ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1232
	^ 105
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1233
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1234
    (documentFormat = 'letter') ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1235
	^ 8.5 * 25.4
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1236
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1237
    "*** more formats needed here ...***"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1238
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1239
    "assuming window size is document size"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1240
    ^ (width / self horizontalPixelPerMillimeter:1) asInteger
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1241
! !
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1242
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1243
!ObjectView methodsFor:'testing objects'!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1244
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1245
frameOf:anObjectOrCollection
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1246
    "answer the maximum extent defined by the argument, anObject or a
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1247
     collection of objects"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1248
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1249
    |first frameAll|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1250
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1251
    anObjectOrCollection isNil ifTrue:[^ nil ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1252
    first := true.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1253
    self forEach:anObjectOrCollection do:[:theObject |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1254
	first ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1255
	    frameAll := theObject frame.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1256
	    first := false
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1257
	] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1258
	    frameAll := frameAll merge:(theObject frame)
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1259
	]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1260
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1261
    ^ frameAll
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1262
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1263
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1264
isObscured:something
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1265
    "return true, if the argument something, anObject or a collection of
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1266
     objects is obscured (partially or whole) by any other object"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1267
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1268
    self forEach:something do:[:anObject |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1269
	(self objectIsObscured:anObject) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1270
	    ^ true
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1271
	]
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1272
    ].
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1273
    ^ false
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1274
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1275
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1276
findObjectAt:aPoint
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1277
    "find the last object (by looking from back to front) which is hit by
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1278
     the argument, aPoint - this is the topmost object hit"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1279
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1280
    |hdelta|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1281
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1282
    hdelta := self class hitDelta.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1283
    contents reverseDo:[:object |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1284
	(object isHitBy:aPoint withDelta:hdelta) ifTrue:[^ object]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1285
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1286
    ^ nil
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1287
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1288
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1289
findObjectAtVisible:aPoint
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1290
    "find the last object (by looking from back to front) which is hit by
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1291
     a visible point - this is the topmost object hit"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1292
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1293
    ^ self findObjectAt:(aPoint "+ self viewOrigin")
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1294
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1295
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1296
isSelected:anObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1297
    "return true, if the argument, anObject is in the selection"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1298
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1299
    selection isNil ifTrue:[^ false].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1300
    (selection == anObject) ifTrue:[^ true].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1301
    (selection isKindOf:Collection) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1302
	^ (selection identityIndexOf:anObject startingAt:1) ~~ 0
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1303
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1304
    ^ false
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1305
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1306
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1307
canMove:something
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1308
    "return true, if the argument, anObject or a collection can be moved"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1309
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1310
    (something isKindOf:Collection) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1311
	self forEach:something do:[:theObject |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1312
	    (theObject canBeMoved) ifFalse:[^ false]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1313
	].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1314
	^ true
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1315
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1316
    ^ something canBeMoved
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1317
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1318
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1319
objectIsObscured:objectToBeTested
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1320
    "return true, if the argument, anObject is obscured (partially or whole)
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1321
     by any other object"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1322
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1323
    |frameToBeTested frameleft frameright frametop framebot
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1324
     objectsFrame startIndex|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1325
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1326
    (objectToBeTested == (contents last)) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1327
	"quick return if object is on top"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1328
	^ false
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1329
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1330
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1331
    frameToBeTested := self frameOf:objectToBeTested.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1332
    frameleft := frameToBeTested left.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1333
    frameright := frameToBeTested right.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1334
    frametop := frameToBeTested top.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1335
    framebot := frameToBeTested bottom.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1336
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1337
    "check objects after the one to check"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1338
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1339
    startIndex := contents identityIndexOf:objectToBeTested ifAbsent:[self error].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1340
    contents from:(startIndex + 1) to:(contents size) do:[:object |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1341
	objectsFrame := self frameOf:object.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1342
	(objectsFrame right < frameleft) ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1343
	    (objectsFrame left > frameright) ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1344
		(objectsFrame bottom < frametop) ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1345
		    (objectsFrame top > framebot) ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1346
			^ true
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1347
		    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1348
		]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1349
	    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1350
	]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1351
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1352
    ^ false
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1353
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1354
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1355
findObjectAt:aPoint suchThat:aBlock
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1356
    "find the last object (back to front ) which is hit by
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1357
     the argument, aPoint and for which the testBlock, aBlock evaluates to
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1358
     true"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1359
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1360
    |hdelta|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1361
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1362
    hdelta := self class hitDelta.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1363
    contents reverseDo:[:object |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1364
	(object isHitBy:aPoint withDelta:hdelta) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1365
	    (aBlock value:object) ifTrue:[^ object]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1366
	]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1367
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1368
    ^ nil
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1369
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1370
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1371
findObjectAtVisible:aPoint suchThat:aBlock
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1372
    "find the last object (back to front ) which is hit by
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1373
     the argument, aPoint and for which the testBlock, aBlock evaluates to
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1374
     true"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1375
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1376
    ^ self findObjectAt:(aPoint "+ self viewOrigin") suchThat:aBlock
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1377
! !
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1378
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1379
!ObjectView methodsFor:'user interface'!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1380
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1381
alignToGrid:aPoint
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1382
    "round aPoint to the next nearest point on the grid"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1383
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1384
    aligning ifFalse:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1385
	^ aPoint
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1386
    ].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1387
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1388
    ^ (aPoint grid:gridAlign) rounded
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1389
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1390
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1391
startSelectOrMove:aPoint
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1392
    "start a rectangleDrag or objectMove - if aPoint hits an object,
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1393
     an object move is started, otherwise a rectangleDrag.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1394
     This is typically the button pressAction."
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1395
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1396
    |anObject|
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1397
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1398
    anObject := self findObjectAtVisible:aPoint.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1399
    anObject notNil ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1400
	(self isSelected:anObject) ifFalse:[self unselect].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1401
	self startObjectMove:anObject at:aPoint.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1402
	^ self
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1403
    ].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1404
    "nothing was hit by this click - this starts a group select"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1405
    self unselect.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1406
    self startRectangleDrag:aPoint
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1407
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1408
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1409
selectMore:aPoint
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1410
    "add/remove an object from the selection"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1411
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1412
    |anObject|
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1413
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1414
    anObject := self findObjectAtVisible:aPoint.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1415
    anObject notNil ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1416
	(self isSelected:anObject) ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1417
	    "remove from selection"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1418
	    self removeFromSelection:anObject
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1419
	] ifFalse:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1420
	    "add to selection"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1421
	    self addToSelection:anObject
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1422
	]
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1423
    ].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1424
    ^ self
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1425
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1426
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1427
startSelectMoreOrMove:aPoint
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1428
    "add/remove object hit by aPoint, then start a rectangleDrag or move 
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1429
     - if aPoint hits an object, a move is started, otherwise a rectangleDrag.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1430
     This is typically the button shiftPressAction."
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1431
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1432
    |anObject|
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1433
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1434
    anObject := self findObjectAtVisible:aPoint.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1435
    anObject notNil ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1436
	(self isSelected:anObject) ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1437
	    "remove from selection"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1438
	    self removeFromSelection:anObject
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1439
	] ifFalse:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1440
	    "add to selection"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1441
	    self addToSelection:anObject
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1442
	].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1443
	self startObjectMove:selection at:aPoint.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1444
	^ self
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1445
    ].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1446
    self unselect.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1447
    self startRectangleDrag:aPoint
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1448
! !
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1449
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1450
!ObjectView methodsFor:'selections'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1451
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1452
unselect
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1453
    "unselect - hide selection; clear selection buffer"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1454
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1455
    self hideSelection.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1456
    selection := nil
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1457
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1458
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1459
selectAllIn:aRectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1460
    "select all objects fully in aRectangle"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1461
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1462
    self hideSelection.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1463
    selection := OrderedCollection new.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1464
    self objectsIn:aRectangle do:[:theObject |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1465
	selection add:theObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1466
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1467
    (selection size == 0) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1468
	selection := nil
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1469
    ] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1470
	(selection size == 1) ifTrue:[selection := selection first]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1471
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1472
    self showSelection
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1473
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1474
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1475
withSelectionHiddenDo:aBlock
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1476
    "evaluate aBlock while selection is hidden"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1477
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1478
    |sel|
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1479
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1480
    sel := selection.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1481
    self unselect.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1482
    aBlock value.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1483
    self select:sel
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1484
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1485
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1486
select:something
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1487
    "select something - hide previouse selection, set to something and hilight"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1488
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1489
    (selection == something) ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1490
	self hideSelection.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1491
	selection := something.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1492
	self showSelection
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1493
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1494
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1495
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1496
selectionDo:aBlock
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1497
    "apply block to every object in selection"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1498
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1499
    self forEach:selection do:aBlock
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1500
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1501
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1502
hideSelection
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1503
    "hide the selection - undraw hilights - whatever that is"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1504
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1505
    self selectionDo:[:object |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1506
	self showUnselected:object
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1507
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1508
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1509
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1510
showSelection
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1511
    "show the selection - draw hilights - whatever that is"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1512
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1513
    self selectionDo:[:object |
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1514
	self showSelected:object
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1515
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1516
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1517
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1518
selectAll
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1519
    "select all objects"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1520
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1521
    self hideSelection.
7
15a9291b9bd0 *** empty log message ***
claus
parents: 5
diff changeset
  1522
    selection := contents copy.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1523
    self showSelection
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1524
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1525
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1526
addToSelection:anObject
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1527
    "add anObject to the selection"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1528
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1529
    (selection isKindOf:Collection) ifFalse:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1530
	selection := OrderedCollection with:selection
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1531
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1532
    selection add:anObject.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1533
    self showSelected:anObject
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1534
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1535
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1536
removeFromSelection:anObject
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1537
    "remove anObject from the selection"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1538
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1539
    (selection isKindOf:Collection) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1540
	selection remove:anObject ifAbsent:[nil].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1541
	(selection size == 1) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1542
	    selection := selection first
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1543
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1544
    ] ifFalse:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1545
	(selection == anObject) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1546
	    selection := nil
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1547
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1548
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1549
    self showUnselected:anObject
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1550
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1551
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1552
selectAllIntersecting:aRectangle
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1553
    "select all objects touched by aRectangle"
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1554
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1555
    self hideSelection.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1556
    selection := OrderedCollection new.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1557
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1558
    self objectsIntersecting:aRectangle do:[:theObject |
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1559
	selection add:theObject
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1560
    ].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1561
    (selection size == 0) ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1562
	selection := nil
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1563
    ] ifFalse:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1564
	(selection size == 1) ifTrue:[selection := selection first]
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1565
    ].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1566
    self showSelection
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1567
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1568
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1569
!ObjectView methodsFor:'initialization'!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1570
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1571
setInitialDocumentFormat
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1572
    (Smalltalk language == #english) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1573
	documentFormat := 'letter'.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1574
	scaleMetric := #inch
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1575
    ] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1576
	documentFormat := 'a4'.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1577
	scaleMetric := #mm
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1578
    ].
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1579
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1580
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1581
initEvents
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1582
    self backingStore:true.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1583
    self enableButtonEvents.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1584
    self enableButtonMotionEvents
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1585
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1586
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1587
initialize
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1588
    |pixPerMM|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1589
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1590
    super initialize.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1591
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1592
    viewBackground := White.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1593
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1594
    bitGravity := #NorthWest.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1595
    contents := OrderedCollection new.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1596
    gridShown := false.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1597
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1598
    canDragOutOfView := false.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1599
    rootView := DisplayRootView new.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1600
    rootView noClipByChildren.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1601
    rootMotion := false.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1602
    self setInitialDocumentFormat.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1603
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1604
    readCursor := Cursor read.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1605
    leftHandCursor := Cursor leftHand.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1606
    sorted := false.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1607
    aligning := false
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1608
! !
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1609
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1610
!ObjectView methodsFor:'adding / removing'!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1611
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1612
addWithoutRedraw:something
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1613
    "add something, anObject or a collection of objects to the contents
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1614
     do not redraw"
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1615
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1616
    self forEach:something do:[:anObject |
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1617
	self addObjectWithoutRedraw:anObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1618
    ]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1619
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1620
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1621
addObjectWithoutRedraw:anObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1622
    "add the argument, anObject to the contents - no redraw"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1623
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1624
    anObject notNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1625
	contents addLast:anObject
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1626
    ]
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1627
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1628
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1629
deleteSelection
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1630
    "delete the selection"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1631
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1632
    buffer := selection.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1633
    self unselect.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1634
    self remove:buffer.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1635
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1636
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1637
pasteBuffer
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1638
    "add the objects in the paste-buffer"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1639
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1640
    self unselect.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1641
    self addSelected:buffer
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1642
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1643
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1644
copySelection
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1645
    "copy the selection into the paste-buffer"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1646
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1647
    buffer := OrderedCollection new.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1648
    self selectionDo:[:object |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1649
	buffer add:(object copy)
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1650
    ].
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1651
    self forEach:buffer do:[:anObject |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1652
	anObject moveTo:(anObject origin + (8 @ 8))
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1653
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1654
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1655
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1656
addSelected:something
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1657
    "add something, anObject or a collection of objects to the contents
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1658
     and select it"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1659
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1660
    self add:something.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1661
    self select:something
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1662
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1663
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1664
remove:something
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1665
    "remove something, anObject or a collection of objects from the contents
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1666
     do redraw"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1667
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1668
    self forEach:something do:[:anObject |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1669
	self removeObject:anObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1670
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1671
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1672
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1673
removeObject:anObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1674
    "remove the argument, anObject from the contents - no redraw"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1675
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1676
    anObject notNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1677
	self removeFromSelection:anObject.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1678
	contents remove:anObject.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1679
	shown "realized" ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1680
	    self redrawObjectsIn:(anObject frame)
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1681
	]
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1682
    ]
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1683
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1684
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1685
addObject:anObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1686
    "add the argument, anObject to the contents - with redraw"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1687
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1688
    anObject notNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1689
	contents addLast:anObject.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1690
	"its on top - only draw this one"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1691
	shown "realized" ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1692
	    self showUnselected:anObject
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1693
	]
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1694
    ]
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1695
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1696
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1697
add:something
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1698
    "add something, anObject or a collection of objects to the contents
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1699
     with redraw"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1700
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1701
    self forEach:something do:[:anObject |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1702
	self addObject:anObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1703
    ]
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1704
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1705
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1706
removeWithoutRedraw:something
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1707
    "remove something, anObject or a collection of objects from the contents
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1708
     do not redraw"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1709
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1710
    self forEach:something do:[:anObject |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1711
	self removeObjectWithoutRedraw:anObject
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1712
    ]
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1713
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1714
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1715
removeObjectWithoutRedraw:anObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1716
    "remove the argument, anObject from the contents - no redraw"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1717
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1718
    anObject notNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1719
	self removeFromSelection:anObject.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1720
	contents remove:anObject
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1721
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1722
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1723
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1724
removeAllWithoutRedraw
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1725
    "remove all - no redraw"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1726
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1727
    selection := nil.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1728
    contents := OrderedCollection new
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1729
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1730
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1731
removeAll
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1732
    "remove all - redraw"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1733
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1734
    self removeAllWithoutRedraw.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1735
    self redraw
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1736
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1737
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1738
!ObjectView methodsFor:'layout manipulation'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1739
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1740
moveObject:anObject to:newOrigin
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1741
    "move anObject to newOrigin, aPoint"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1742
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1743
    |oldOrigin oldFrame newFrame 
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1744
     objectsIntersectingOldFrame objectsIntersectingNewFrame 
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1745
     wasObscured isObscured intersects
69
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  1746
     vx vy oldLeft oldTop w h newLeft newTop griddedNewOrigin viewOrigin|
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1747
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1748
    anObject isNil ifTrue:[^ self].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1749
    anObject canBeMoved ifFalse:[^ self].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1750
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
  1751
    griddedNewOrigin := self alignToGrid:newOrigin.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1752
    oldOrigin := anObject origin.
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
  1753
    (oldOrigin = griddedNewOrigin) ifTrue:[^ self].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1754
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1755
    oldFrame := self frameOf:anObject.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1756
    objectsIntersectingOldFrame := self objectsIntersecting:oldFrame.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1757
    wasObscured := self isObscured:anObject.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1758
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 24
diff changeset
  1759
    anObject moveTo:griddedNewOrigin.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1760
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1761
    newFrame := self frameOf:anObject.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1762
    objectsIntersectingNewFrame := self objectsIntersecting:newFrame.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1763
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1764
    "try to redraw the minimum possible"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1765
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1766
    "if no other object intersects both frames we can do a copy:"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1767
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1768
    viewOrigin := 0@0 "self viewOrigin".
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1769
    intersects := oldFrame intersects:newFrame.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1770
    intersects ifFalse:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1771
	gridShown ifFalse:[
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1772
	    transformation isNil ifTrue:[
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1773
		(objectsIntersectingOldFrame size == 1) ifTrue:[
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1774
		    (objectsIntersectingNewFrame size == 1) ifTrue:[
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1775
			(oldFrame isContainedIn:self clipRect) ifTrue:[
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1776
			    vx := viewOrigin x.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1777
			    vy := viewOrigin y.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1778
			    oldLeft := oldFrame left - vx.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1779
			    oldTop := oldFrame top - vy.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1780
			    newLeft := newFrame left - vx.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1781
			    newTop := newFrame top - vy.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1782
			    w := oldFrame width.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1783
			    h := oldFrame height.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1784
			    ((newLeft < width) and:[newTop < height]) ifTrue:[
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1785
				((newLeft >= 0) and:[newTop >= 0]) ifTrue:[
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1786
				    self catchExpose.
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1787
				    self copyFrom:self x:oldLeft y:oldTop
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1788
						     toX:newLeft y:newTop
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1789
						   width:w height:h.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1790
				    self waitForExpose
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1791
				]
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1792
			    ].
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1793
			    ((oldLeft < width) and:[oldTop < height]) ifTrue:[
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1794
				((oldLeft >= 0) and:[oldTop >= 0]) ifTrue:[
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1795
				  self clearRectangleX:oldLeft y:oldTop width:w height:h.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1796
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1797
"/                                self fillRectangleX:oldLeft y:oldTop width:w height:h
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1798
"/                                               with:viewBackground
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1799
				]
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1800
			    ].
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1801
			    ^ self
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  1802
			]
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1803
		    ]
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1804
		]
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1805
	    ]
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1806
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1807
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1808
    isObscured := self isObscured:anObject.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1809
    (oldFrame intersects:newFrame) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1810
	isObscured ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1811
	    self redrawObjectsIn:oldFrame.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1812
	    self show: anObject
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1813
	] ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1814
	    self redrawObjectsIn:(oldFrame merge:newFrame)
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1815
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1816
    ] ifFalse:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1817
	self redrawObjectsIn:oldFrame.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1818
	isObscured ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1819
	    self show: anObject
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1820
	] ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1821
	    self redrawObjectsIn:newFrame
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1822
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1823
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1824
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1825
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1826
move:something by:delta
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1827
    "change the position of something, an Object or Collection 
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1828
     by delta, aPoint"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1829
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1830
    (delta x == 0) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1831
	(delta y == 0) ifTrue:[^ self]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1832
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1833
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1834
    self forEach:something do:[:anObject |
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1835
	self moveObject:anObject by:delta
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1836
    ]
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1837
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1838
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1839
moveObject:anObject by:delta
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1840
    "change the position of anObject by delta, aPoint"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1841
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1842
    self moveObject:anObject to:(anObject origin + delta)
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1843
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  1844
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1845
move:something to:aPoint in:aView
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1846
    "can only happen when dragOutOfView is true
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1847
     - should be redefined in subclasses"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1848
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1849
    self notify:'cannot move object(s) out of view'
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1850
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1851
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1852
move:something to:aPoint inAlienViewId:aViewId
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1853
    "can only happen when dragOutOfView is true
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1854
     - should be redefined in subclasses"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1855
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1856
    self notify:'cannot move object(s) to alien views'
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1857
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  1858
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1859
objectToFront:anObject
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1860
    "bring the argument, anObject to front"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1861
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1862
    |wasObscured|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1863
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1864
    anObject notNil ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1865
	wasObscured := self isObscured:anObject.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1866
	contents remove:anObject.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1867
	contents addLast:anObject.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1868
	wasObscured ifTrue:[
7
15a9291b9bd0 *** empty log message ***
claus
parents: 5
diff changeset
  1869
"old:
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1870
	    self redrawObjectsIn:(anObject frame)
7
15a9291b9bd0 *** empty log message ***
claus
parents: 5
diff changeset
  1871
"
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1872
	    self hideSelection.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1873
	    self show:anObject.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1874
	    self showSelection
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1875
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1876
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1877
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1878
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1879
toFront:something
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1880
    "bring the argument, anObject or a collection of objects to front"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1881
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1882
    self forEach:something do:[:anObject |
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1883
	self objectToFront:anObject
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1884
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1885
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1886
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1887
selectionToFront
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1888
    "bring the selection to front"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1889
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1890
    self toFront:selection
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1891
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1892
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1893
objectToBack:anObject
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1894
    "bring the argument, anObject to back"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1895
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1896
    anObject notNil ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1897
	contents remove:anObject.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1898
	contents addFirst:anObject.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1899
	(self isObscured:anObject) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1900
	    self redrawObjectsIn:(anObject frame)
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1901
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1902
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1903
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1904
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1905
toBack:something
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1906
    "bring the argument, anObject or a collection of objects to back"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1907
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1908
    self forEach:something do:[:anObject |
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1909
	self objectToBack:anObject
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1910
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1911
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1912
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1913
selectionToBack
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1914
    "bring the selection to back"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1915
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1916
    self toBack:selection
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1917
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1918
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1919
alignLeft:something
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1920
    |leftMost|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1921
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1922
    leftMost := 999999.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1923
    self forEach:something do:[:anObject |
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1924
	leftMost := leftMost min:(anObject frame left)
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1925
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1926
    self withSelectionHiddenDo:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1927
	self forEach:something do:[:anObject |
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1928
	    self moveObject:anObject to:(leftMost @ (anObject frame top))
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1929
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1930
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1931
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1932
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1933
alignRight:something
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1934
    |rightMost|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1935
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1936
    rightMost := -999999.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1937
    self forEach:something do:[:anObject |
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1938
	rightMost := rightMost max:(anObject frame right)
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1939
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1940
    self withSelectionHiddenDo:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1941
	self forEach:something do:[:anObject |
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1942
	    self moveObject:anObject to:(rightMost - (anObject frame width))
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1943
					 @ (anObject frame top)
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1944
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1945
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1946
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1947
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1948
alignTop:something
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1949
    |topMost|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1950
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1951
    topMost := 999999.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1952
    self forEach:something do:[:anObject |
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1953
	topMost := topMost min:(anObject frame top)
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1954
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1955
    self withSelectionHiddenDo:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1956
	self forEach:something do:[:anObject |
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1957
	    self moveObject:anObject to:((anObject frame left) @ topMost)
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1958
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1959
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1960
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1961
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1962
alignBottom:something
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1963
    |botMost|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1964
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1965
    botMost := -999999.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1966
    self forEach:something do:[:anObject |
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1967
	botMost := botMost max:(anObject frame bottom)
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1968
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1969
    self withSelectionHiddenDo:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1970
	self forEach:something do:[:anObject |
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1971
	    self moveObject:anObject to:(anObject frame left)
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1972
					@
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1973
					(botMost - (anObject frame height))
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  1974
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1975
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1976
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1977
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1978
selectionAlignLeft
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1979
    "align selected objects left"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1980
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1981
    self alignLeft:selection
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1982
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1983
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1984
selectionAlignRight
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1985
    "align selected objects right"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1986
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1987
    self alignRight:selection
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1988
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1989
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1990
selectionAlignTop
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1991
    "align selected objects at top"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1992
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1993
    self alignTop:selection
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1994
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1995
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1996
selectionAlignBottom
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1997
    "align selected objects at bottom"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1998
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1999
    self alignBottom:selection
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2000
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2001
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2002
!ObjectView methodsFor:'dragging rectangle'!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2003
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2004
endRectangleDrag
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2005
    "cleanup after rectangle drag; select them"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2006
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2007
    self invertDragRectangle.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2008
    self cursor:oldCursor.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2009
    self selectAllIn:(dragObject "+ self viewOrigin")
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2010
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2011
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2012
invertDragRectangle
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2013
    "helper for rectangle drag - invert the dragRectangle.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2014
     Extracted into a separate method to allow easier redefinition
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2015
     (different lineWidth etc)"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2016
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2017
    self xoring:[self lineWidth:0. self displayRectangle:dragObject].
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2018
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2019
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2020
startRectangleDrag:startPoint
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2021
    "start a rectangle drag"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2022
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2023
    self setRectangleDragActions.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2024
    dragObject := Rectangle origin:startPoint corner:startPoint.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2025
    self invertDragRectangle.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2026
    oldCursor := cursor.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2027
    self cursor:leftHandCursor
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2028
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2029
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2030
doRectangleDrag:aPoint
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2031
    "do drag a rectangle"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2032
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2033
    self invertDragRectangle.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2034
    dragObject corner:aPoint.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2035
    self invertDragRectangle.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2036
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2037
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2038
!ObjectView methodsFor:'view manipulation'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2039
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2040
zoom:factor
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2041
    "set a zoom factor; nil or 1 is identity; 2 is magnify by 2;
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2042
     0.5 is shrink by 2"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2043
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2044
    |current|
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2045
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2046
    transformation isNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2047
	current := 1@1
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2048
    ] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2049
	current := transformation scale
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2050
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2051
    factor asPoint = current asPoint ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2052
	^ self
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2053
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2054
    current := factor.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2055
    current isNil ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2056
	current := 1
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2057
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2058
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2059
    (current = 1) ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2060
	transformation := nil
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2061
    ] ifFalse:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2062
	transformation := WindowingTransformation scale:current translation:0.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2063
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2064
    self contentsChanged.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2065
    self setInnerClip.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2066
    gridShown ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2067
	self newGrid
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2068
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2069
    shown ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2070
	self clear.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2071
	self redraw
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2072
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2073
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2074
69
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2075
zoomIn
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2076
    transformation isNil ifTrue:[
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2077
	transformation := WindowingTransformation scale:1 translation:0
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2078
    ].
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2079
    transformation := WindowingTransformation scale:(transformation scale / 2)
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2080
					      translation:0.
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2081
    self contentsChanged.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2082
    self setInnerClip.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2083
    self redraw.
69
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2084
!
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2085
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2086
zoomOut
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2087
    transformation isNil ifTrue:[
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2088
	transformation := WindowingTransformation scale:1 translation:0
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2089
    ].
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2090
    transformation := WindowingTransformation scale:(transformation scale * 2)
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2091
					      translation:0.
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2092
    self contentsChanged.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2093
    self setInnerClip.
69
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2094
    self redraw
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2095
!
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2096
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2097
millimeterMetric
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2098
    (scaleMetric ~~ #mm) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2099
	scaleMetric := #mm.
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2100
	self newGrid
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2101
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2102
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2103
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2104
inchMetric
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2105
    (scaleMetric ~~ #inch) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2106
	scaleMetric := #inch.
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2107
	self newGrid
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2108
    ]
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2109
! !
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2110
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2111
!ObjectView methodsFor:'grid manipulation'!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2112
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2113
newGrid
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2114
    "define a new grid"
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2115
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2116
    gridPixmap := nil.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2117
    shown ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2118
	self viewBackground:White.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2119
	self clear.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2120
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2121
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2122
    gridShown ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2123
	self defineGrid.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2124
	self viewBackground:gridPixmap.
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2125
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2126
    shown ifTrue:[
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2127
	self redraw
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2128
    ].
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2129
!
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2130
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2131
gridParameters
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2132
    "used by defineGrid, and in a separate method for
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2133
     easier redefinition in subclasses. 
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2134
     Returns the parameters in an array of 7 elements,
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2135
     which control the appearance of the grid-pattern.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2136
     elements:
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2137
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2138
	bigStepH        number of pixels horizontally between 2 major steps
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2139
	bigStepV        number of pixels vertically between 2 major steps
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2140
	littleStepH     number of pixels horizontally between 2 minor steps
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2141
	littleStepV     number of pixels vertically between 2 minor steps
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2142
	gridAlignH      number of pixels for horizontal grid align
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2143
	gridAlignV      number of pixels for vertical grid align
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2144
	docBounds       true, if document boundary shouldbe shown
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2145
    "
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2146
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2147
    |mmH mmV bigStepH bigStepV littleStepH littleStepV arr|
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2148
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2149
    "example: 12grid & 12snapIn"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2150
"/    ^ #(12 12 nil nil 12 12 false).
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2151
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2152
    "example: 12grid & 24snapIn"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2153
"/    ^ #(12 12 nil nil 24 24 false).
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2154
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2155
    "default: cm/mm grid & mm snapIn for metric,
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2156
     1inch , 1/8inch grid & 1/8 inch snapIn"
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2157
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2158
    mmH := self horizontalPixelPerMillimeter.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2159
    mmV := self verticalPixelPerMillimeter.
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2160
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2161
    (scaleMetric == #mm) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2162
	"dots every mm; lines every cm"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2163
	bigStepH := mmH * 10.0.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2164
	bigStepV := mmV * 10.0.
69
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2165
	(transformation notNil
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2166
	and:[transformation scale <= 0.5]) ifFalse:[
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2167
	    littleStepH := mmH.
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2168
	    littleStepV := mmV
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2169
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2170
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2171
    (scaleMetric == #inch) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2172
	"dots every eights inch; lines every half inch"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2173
	bigStepH := mmH * (25.4 / 2).
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2174
	bigStepV := mmV * (25.4 / 2).
69
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2175
	(transformation notNil
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2176
	and:[transformation scale <= 0.5]) ifTrue:[
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2177
	    littleStepH := mmH * (25.4 / 4).
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2178
	    littleStepV := mmV * (25.4 / 4)
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2179
	] ifFalse:[
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2180
	    littleStepH := mmH * (25.4 / 8).
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2181
	    littleStepV := mmV * (25.4 / 8)
2b72a20e61c2 *** empty log message ***
claus
parents: 68
diff changeset
  2182
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2183
    ].
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2184
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2185
    arr := Array new:8.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2186
    arr at:1 put:bigStepH.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2187
    arr at:2 put:bigStepV.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2188
    arr at:3 put:littleStepH.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2189
    arr at:4 put:littleStepV.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2190
    arr at:5 put:littleStepH.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2191
    arr at:6 put:littleStepV.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2192
    arr at:7 put:false.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2193
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2194
    ^ arr
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2195
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2196
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2197
defineGrid
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2198
    "define the grid pattern"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2199
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2200
    |mmH mmV params showDocumentBoundary gridW gridH 
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2201
     bigStepH bigStepV littleStepH littleStepV hires|
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2202
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2203
    mmH := self horizontalPixelPerMillimeter.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2204
    mmV := self verticalPixelPerMillimeter.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2205
    hires := self horizontalPixelPerInch > 120.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2206
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2207
    gridW := (self widthOfContentsInMM * mmH).
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2208
    gridH := (self heightOfContentsInMM * mmV).
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2209
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2210
    params := self gridParameters.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2211
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2212
    bigStepH := params at:1.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2213
    bigStepV := params at:2.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2214
    littleStepH := params at:3.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2215
    littleStepV := params at:4.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2216
    showDocumentBoundary := params at:7.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2217
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2218
    transformation notNil ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2219
	mmH := mmH * transformation scale x.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2220
	mmV := mmV * transformation scale y.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2221
	bigStepH := bigStepH * transformation scale x.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2222
	bigStepV := bigStepV * transformation scale y.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2223
	littleStepH notNil ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2224
	    littleStepH := littleStepH * transformation scale x.
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2225
	].
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2226
	littleStepV notNil ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2227
	    littleStepV := littleStepV * transformation scale y.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2228
	].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2229
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2230
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2231
    bigStepH isNil ifTrue:[^ self].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2232
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2233
    self withCursor:(Cursor wait) do:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2234
	|xp yp y x|
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2235
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2236
	"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2237
	 up to next full unit
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2238
	"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2239
	gridW := ((gridW // bigStepH) + 1 * bigStepH) asInteger.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2240
	gridH := ((gridH // bigStepV) + 1 * bigStepV) asInteger.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2241
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2242
	gridPixmap := Form width:gridW height:gridH depth:1.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2243
	gridPixmap colorMap:(Array with:White with:Black).
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2244
	gridPixmap clear.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2245
	gridPixmap paint:(Color colorId:1).
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2246
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2247
	"draw first row point-by-point"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2248
	yp := 0.0.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2249
	xp := 0.0.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2250
	y := yp asInteger.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2251
	[xp <= gridW] whileTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2252
	    x := xp rounded.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2253
	    hires ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2254
		gridPixmap displayPointX:(x + 1) y:y.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2255
		gridPixmap displayPointX:(x + 2) y:y
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2256
	    ].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2257
	    gridPixmap displayPointX:x y:y.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2258
	    littleStepH notNil ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2259
		xp := xp + littleStepH
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2260
	    ] ifFalse:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2261
		xp := xp + bigStepH
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2262
	    ]
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2263
	].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2264
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2265
	"copy rest from what has been drawn already"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2266
	yp := yp + bigStepV.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2267
	[yp <= gridH] whileTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2268
	    y := yp rounded.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2269
	    hires ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2270
		gridPixmap copyFrom:gridPixmap x:0 y:0 
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2271
					     toX:0 y:(y + 1)
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2272
					   width:gridW height:1.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2273
		gridPixmap copyFrom:gridPixmap x:0 y:0 
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2274
					     toX:0 y:(y + 2)
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2275
					   width:gridW height:1
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2276
	    ].
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2277
	    gridPixmap copyFrom:gridPixmap x:0 y:0 
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2278
					 toX:0 y:y
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2279
				       width:gridW height:1.
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2280
	    yp := yp + bigStepV
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2281
	].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2282
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2283
	"draw first col point-by-point"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2284
	xp := 0.0.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2285
	yp := 0.0.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2286
	x := xp asInteger.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2287
	[yp <= gridH] whileTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2288
	    y := yp rounded.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2289
	    hires ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2290
		gridPixmap displayPointX:x y:(y + 1).
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2291
		gridPixmap displayPointX:x y:(y + 2)
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2292
	    ].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2293
	    gridPixmap displayPointX:x y:y.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2294
	    littleStepV notNil ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2295
		yp := yp + littleStepV
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2296
	    ] ifFalse:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2297
		yp := yp + bigStepV
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2298
	    ]
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2299
	].
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2300
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2301
	"copy rest from what has been drawn already"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2302
	xp := xp + bigStepH.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2303
	[xp <= gridW] whileTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2304
	    x := xp rounded.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2305
	    hires ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2306
		gridPixmap copyFrom:gridPixmap x:0 y:0 
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2307
					     toX:(x + 1) y:0
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2308
					   width:1 height:gridH.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2309
		gridPixmap copyFrom:gridPixmap x:0 y:0 
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2310
					     toX:(x + 2) y:0
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2311
					   width:1 height:gridH
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2312
	    ].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2313
	    gridPixmap copyFrom:gridPixmap x:0 y:0 
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2314
					 toX:x y:0
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2315
				       width:1 height:gridH.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2316
	    xp := xp + bigStepH
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2317
	].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2318
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2319
	showDocumentBoundary ifTrue:[
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2320
	     "
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2321
	     mark the right-end and bottom of the document
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2322
	    "
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2323
	    gridPixmap displayLineFromX:gridW-1 y:0 toX:gridW-1 y:gridH-1.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2324
	    gridPixmap displayLineFromX:0 y:gridH-1 toX:gridW-1 y:gridH-1.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2325
	].
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2326
    ]
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2327
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2328
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2329
showGrid
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2330
    "show the grid"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2331
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2332
    gridShown := true.
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2333
    self newGrid
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2334
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2335
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2336
hideGrid
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2337
    "hide the grid"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2338
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2339
    gridShown := false.
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2340
    self newGrid
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2341
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2342
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2343
getAlignParameters
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2344
    |params|
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2345
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2346
    params := self gridParameters.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2347
    gridAlign := (params at:5) @ (params at:6)
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2348
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2349
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2350
alignOn
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2351
    "align points to grid"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2352
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2353
    |params|
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2354
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2355
    aligning := true.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2356
    self getAlignParameters
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2357
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2358
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2359
alignOff
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2360
    "do no align point to grid"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2361
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2362
    aligning := false
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2363
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2364
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2365
!ObjectView methodsFor:'dragging line'!
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2366
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2367
startLineDrag:startPoint
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2368
    "start a line drag"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2369
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2370
    self setLineDragActions.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2371
    dragObject := Rectangle origin:startPoint corner:startPoint.
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2372
    self invertDragLine.
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2373
    oldCursor := cursor.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2374
    self cursor:leftHandCursor
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2375
!
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2376
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2377
startRootLineDrag:startPoint
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2378
    "start a line drag possibly crossing my view boundaries"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2379
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2380
    self setLineDragActions.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2381
    rootMotion := true.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2382
    dragObject := Rectangle origin:startPoint corner:startPoint.
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2383
    self invertDragLine.
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2384
    oldCursor := cursor.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2385
    self cursor:leftHandCursor
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2386
!
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2387
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2388
doLineDrag:aPoint
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2389
    "do drag a line"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2390
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2391
    |dragger top org|
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2392
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2393
    rootMotion ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2394
	dragger := rootView.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2395
	top := self topView.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2396
	org := device translatePoint:0@0 from:(self id) to:(rootView id).
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2397
    ] ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2398
	dragger := self.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2399
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2400
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2401
    self invertDragLine.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2402
    dragObject corner:aPoint.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2403
    self invertDragLine.
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2404
!
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2405
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2406
endLineDrag
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2407
    "cleanup after line drag; select them. Find the origin and destination
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2408
     views and relative offsets, then dispatch to one of the endLineDrag methods.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2409
     These can be redefined in subclasses to allow connect between views."
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2410
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2411
    |dragger offs2 top org rootPoint viewId  
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2412
     lastViewId destinationId destinationView destinationPoint inMySelf|
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2413
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2414
    rootMotion ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2415
	dragger := rootView.
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2416
	offs2 := 0@0 "self viewOrigin".
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2417
	top := self topView.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2418
	org := device translatePoint:0@0 from:(self id) to:(rootView id).
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2419
	offs2 := offs2 - org
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2420
    ] ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2421
	dragger := self.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2422
	offs2 := 0@0.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2423
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2424
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2425
    dragger xoring:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2426
	dragger displayLineFrom:dragObject origin-offs2 
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2427
			     to:dragObject corner-offs2
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2428
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2429
    self cursor:oldCursor.
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2430
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2431
    "check if line drag is into another view"
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2432
    rootMotion ifTrue:[
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2433
	rootPoint := device translatePoint:lastButt
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2434
				      from:(self id) 
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2435
					to:(rootView id).
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2436
	"search view the drop is in"
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2437
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2438
	viewId := rootView id.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2439
	[viewId notNil] whileTrue:[
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2440
	    destinationId := device viewIdFromPoint:rootPoint in:viewId.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2441
	    lastViewId := viewId.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2442
	    viewId := destinationId
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2443
	].
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2444
	destinationView := device viewFromId:lastViewId.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2445
	destinationId := lastViewId.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2446
	inMySelf := (destinationView == self).
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2447
	rootMotion := false
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2448
    ] ifFalse:[
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2449
	inMySelf := true
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2450
    ].
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2451
    inMySelf ifTrue:[
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2452
	"a simple line within myself"
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2453
	self lineDragFrom:dragObject origin
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2454
			  to:dragObject corner
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2455
    ] ifFalse:[
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2456
	"into another one"
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2457
	destinationPoint := device translatePoint:rootPoint
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2458
					     from:(rootView id) 
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2459
					       to:(destinationView id).
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2460
	destinationView notNil ifTrue:[
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2461
	    "
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2462
	     move into another smalltalk view
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2463
	    "
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2464
	    self lineDragFrom:dragObject origin to:destinationPoint in:destinationView
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2465
	] ifFalse:[
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2466
	    "
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2467
	     not one of my views
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2468
	    "
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2469
	    self lineDragFrom:dragObject origin
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2470
			   to:destinationPoint 
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2471
			   inAlienViewId:destinationId
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2472
	] 
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2473
    ].
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2474
    self setDefaultActions.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2475
    dragObject := nil
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2476
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2477
!
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2478
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2479
lineDragFrom:startPoint to:endPoint inAlienViewId:destinationId
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2480
    "this is called after a line-drag with rootmotion set
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2481
     to true, IFF the endpoint is in an alien view
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2482
     - should be redefined in subclasses"
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2483
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2484
    self notify:'cannot connect object in alien view'
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2485
!
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2486
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2487
lineDragFrom:startPoint to:endPoint
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2488
    "this is called after a line-drag. Nothing is done here.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2489
     - should be redefined in subclasses"
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2490
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2491
    ^ self
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2492
!
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2493
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2494
lineDragFrom:startPoint to:endPoint in:destinationView
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2495
    "this is called after a line-drag crossing view boundaries.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2496
     - should be redefined in subclasses"
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2497
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
  2498
    ^ self notify:'dont know how to connect to external views'
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2499
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2500
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2501
invertDragLine
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2502
    "helper for line dragging - invert the dragged line.
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2503
     Extracted for easier redefinition in subclasses
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2504
     (different line width etc.)"
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2505
71
9fd1c36af7a8 last version before big scrolling change
claus
parents: 70
diff changeset
  2506
    self xoring:[self lineWidth:0. self displayLineFrom:dragObject origin to:dragObject corner].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2507
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2508
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2509
!ObjectView methodsFor:'saving / restoring'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2510
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2511
initializeFileInObject:anObject
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2512
    "each object may be processed here after its being filed-in
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2513
     - subclasses may do whatever they want here ...
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2514
     (see LogicView for example)"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2515
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2516
    ^ self
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2517
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2518
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2519
storeContentsOn:aStream
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2520
    "store the contents in textual representation on aStream.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2521
     Notice, that for huge objects (such as DrawImages) this ascii output
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2522
     can become quite large, and the time to save and reload can become
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2523
     long."
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2524
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2525
    |excla|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2526
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2527
    self topView withCursor:Cursor write do:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2528
	excla := aStream class chunkSeparator.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2529
	self forEach:contents do:[:theObject |
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2530
	    theObject storeOn:aStream.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2531
	    aStream nextPut:excla.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2532
	    aStream cr
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2533
	].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2534
	aStream nextPut:excla
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2535
    ]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2536
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2537
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2538
withoutRedrawFileInContentsFrom:aStream
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2539
    self fileInContentsFrom:aStream redraw:false
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2540
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2541
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2542
fileInContentsFrom:aStream
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2543
    "remove all objects, load new contents from aStream and redraw"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2544
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2545
    self fileInContentsFrom:aStream redraw:true
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2546
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2547
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2548
fileInContentsFrom:aStream redraw:redraw new:new
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2549
    "if the new argument is true, remove all objects.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2550
     Then load objects from aStream, 
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2551
     finally, redraw if the redraw argument is true"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2552
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2553
    |newObject chunk|
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2554
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2555
    self topView withCursor:Cursor read do:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2556
	self unselect.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2557
	new ifTrue:[self removeAll].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2558
	[aStream atEnd] whileFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2559
	    chunk := aStream nextChunk.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2560
	    chunk notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2561
		chunk isEmpty ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2562
		    newObject := Compiler evaluate:chunk.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2563
		    self initializeFileInObject:newObject.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2564
		    redraw ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2565
			self addObjectWithoutRedraw:newObject
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2566
		    ] ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2567
			self addObject:newObject
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2568
		    ]
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2569
		]
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2570
	    ]
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2571
	].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
  2572
    ]
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2573
!
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2574
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2575
fileInContentsFrom:aStream redraw:redraw
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2576
    "remove all objects, load new contents from aStream 
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2577
     and redraw if the redraw argument is true"
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2578
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2579
    self fileInContentsFrom:aStream redraw:redraw new:true
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  2580
! !
63
f4eaf04d1eaf *** empty log message ***
claus
parents: 60
diff changeset
  2581