'From Squeak4.5 of 31 December 2013 [latest update: #13405] on 9 January 2014 at 5:43:22 pm'! Morph subclass: #DragSourceMorph instanceVariableNames: 'provideCopy' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Demo'! !DragSourceMorph commentStamp: 'tpr 1/8/2014 13:15' prior: 0! A DragSourceMorph is an extremely simple morph - it provides for user actions dragging submorphs out, presumably to drop somewhere else. It is a subclass of Morph, so no borders or background are provided; instead you add instances to other morphs in order to composite all those extra features. Changing the DragSourceMorph's layout policy can force it to keep things in a nice order, should you need that. The default is simply to set the v/hResizing to #spaceFill to help with fitting it into a container. By default you drag the actual morph out - to drag a copy, first send providesCopy: true. See the class examples DragSourceMorph example1 DragSourceMorph example2 ! Morph subclass: #DragTargetMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Demo'! !DragTargetMorph commentStamp: 'tpr 1/8/2014 13:15' prior: 0! A DragTargetMorph is a simple morph that accepts drop events by putting the dropped morph onto a grid. It doesn't do any clever testing of the resulting position or extent of the droppee, so don't be too surprised by what happens if you drop a large morph on it. Try DragTargetMorph example1! !DragSourceMorph methodsFor: 'initialization' stamp: 'tpr 1/8/2014 10:45'! initialize super initialize. "set a default layout policy of #fillSpace" self hResizing: #spaceFill; vResizing: #spaceFill; color: Color transparent! ! !DragSourceMorph methodsFor: 'accessing' stamp: 'tpr 1/6/2014 17:00'! targetMorphAt: evt "find the submorph clicked on, if any" | hits | hits := self morphsAt: evt cursorPoint. "if there are no hits or more than one, fuggedaboudit. filter the list to only direct submorphs" hits := hits select:[:m| m owner == self]. (hits isEmpty or:[hits size >1]) ifTrue:[^nil]. ^hits first ! ! !DragSourceMorph methodsFor: 'dropping/grabbing' stamp: 'tpr 1/9/2014 14:39'! startDrag: evt "someone is trying to drag a submorph; find which one and attach it to the event's hand" | hit | (hit := self targetMorphAt: evt) ifNil:[^self]. evt hand grabMorph: hit duplicate ! ! !DragSourceMorph methodsFor: 'event handling' stamp: 'wiz 8/23/2005 19:31'! handlesMouseDown: evt ^ true! ! !DragSourceMorph methodsFor: 'event handling' stamp: 'tpr 1/6/2014 17:04'! mouseDown: evt "Do nothing upon mouse-down except inform the hand to watch for a drag: message. Don't even do that if there are no submorphs" (self targetMorphAt: evt) ifNotNil: [evt hand waitForClicksOrDrag: self event: evt selectors: {nil. nil. nil. #startDrag:} threshold: HandMorph dragThreshold]! ! !DragSourceMorph class methodsFor: 'examples' stamp: 'tpr 1/9/2014 16:33'! example1 "DragSourceMorph example1" "Build a really simple exemplar of DragSourceMorph - it fills a containing morph, includes two circle morphs and allows us to drag a copy of that circle out;" |m d| m := RectangleMorph new extent: 100@300. m color: Color red. m layoutPolicy: TableLayout new. d:= DragSourceMorph new. d layoutPolicy: TableLayout new. d listDirection: #topToBottom; wrapCentering: #center; hResizing: #spaceFill; vResizing: #spaceFill. d addMorph: (CircleMorph new extent: 40@40; color: Color white). d addMorph: (CircleMorph new extent: 40@40; color: Color black). m addMorph: d. m openInWorld! ! !DragTargetMorph methodsFor: 'accessing' stamp: 'tpr 1/8/2014 12:08'! gridModulus "answer the size of the grid we are placing dropped morphs on" ^40@40! ! !DragTargetMorph methodsFor: 'dropping/grabbing' stamp: 'tpr 1/8/2014 13:08'! acceptDroppingMorph: aMorph event: evt "deal with the actual morph; in this case add it but force the position to a grid" "If there is a layout policy in use, obey it rather than the grid" | newPos | self layoutPolicy ifNotNil:[^super acceptDroppingMorph: aMorph event: evt]. "set the morph's position" newPos := (evt cursorPoint - self position) truncateTo: self gridModulus. aMorph position: newPos+ self position. "add the morph" self addMorph: aMorph! ! !DragTargetMorph methodsFor: 'dropping/grabbing' stamp: 'tpr 1/9/2014 16:24'! wantsDroppedMorph: aMorph event: evt "I want them all" ^aMorph class = CircleMorph! ! !DragTargetMorph methodsFor: 'initialization' stamp: 'tpr 1/8/2014 12:11'! initialize super initialize. "set a default layout policy of #fillSpace" self hResizing: #spaceFill; vResizing: #spaceFill; color: Color transparent! ! !DragTargetMorph class methodsFor: 'examples' stamp: 'tpr 1/9/2014 14:45'! example1 "DragTargetMorph example1" "Build a really simple exemplar of DragTargeteMorph" |m d| m := RectangleMorph new extent: 300@300. m color: Color blue. m layoutPolicy: TableLayout new. m hResizing: #shrinkWrap; vResizing: #shrinkWrap. d:= DragTargetMorph new. d extent: 40 @ 40 * 5. "5 x 5 grid for demo" d hResizing: #rigid; vResizing: #rigid. m addMorph: d. m openInWorld! !