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