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