'From Squeak3.1alpha of 5 February 2001 [latest update: #3972] on 4 May 2001 at 2:04:21 pm'! "Change Set: UTDropZones Date: 4 May 2001 Author: Dan Ingalls Reworks the drop zones in universal tiles to be simple green like classic tiles. Also reworks the replacement drop highlight to be similar to classic tiles. "! !SyntaxMorph methodsFor: 'event handling' stamp: 'di 5/4/2001 13:23'! mouseEnter: evt "Highlight this level as a potential grab target" "Transcript cr; print: self; show: ' enter'." self unhighlightOwnerBorder. self highlightForGrab: evt. evt hand newKeyboardFocus: self. ! ! !SyntaxMorph methodsFor: 'event handling' stamp: 'di 5/4/2001 13:23'! mouseEnterDragging: evt "Highlight this level as a potential drop target" "Transcript cr; print: self; show: ' enterDragging'." evt hand hasSubmorphs ifFalse: [^ self]. "Don't react to empty hand" self unhighlightOwnerBorder. self highlightForDrop: evt. self isBlockNode ifTrue: [(self firstOwnerSuchThat: [:m | m isSyntaxMorph and: [m isBlockNode]]) ifNotNilDo: [:m | "Suspend outer block." m stopStepping; removeDropZones]. self startStepping] ! ! !SyntaxMorph methodsFor: 'event handling' stamp: 'di 5/4/2001 13:22'! mouseLeave: evt "Move grab highlight back out a level" "Transcript cr; print: self; show: ' leave'." self unhighlightBorder. (owner ~~ nil and: [owner isSyntaxMorph]) ifTrue: [owner highlightForGrab: evt]. ! ! !SyntaxMorph methodsFor: 'event handling' stamp: 'di 5/4/2001 14:00'! mouseLeaveDragging: evt "Transcript cr; print: self; show: ' leaveDragging'." self isBlockNode ifTrue: [self stopStepping; removeDropZones. (self firstOwnerSuchThat: [:m | m isSyntaxMorph and: [m isBlockNode]]) ifNotNilDo: [:m | "Activate outer block." m startStepping]]. "Move drop highlight back out a level" self unhighlight. (owner ~~ nil and: [owner isSyntaxMorph]) ifTrue: [owner highlightForDrop: evt]. ! ! !SyntaxMorph methodsFor: 'highlighting' stamp: 'di 5/4/2001 13:16'! highlightForDrop: evt (self wantsDroppedMorph: evt hand firstSubmorph event: evt) ifTrue: [self color: self dropColor].! ! !SyntaxMorph methodsFor: 'highlighting' stamp: 'di 5/4/2001 13:25'! unhighlight self currentSelectionDo: [:innerMorph :mouseDownLoc :outerMorph | self color: ( false "(self == outerMorph or: [owner notNil and: [owner isSyntaxMorph not]])" ifTrue: [self valueOfProperty: #deselectedBorderColor ifAbsent: [#raised]] ifFalse: [self color: Color transparent] ) ] ! ! !SyntaxMorph methodsFor: 'highlighting' stamp: 'di 5/4/2001 13:21'! unhighlightBorder self currentSelectionDo: [:innerMorph :mouseDownLoc :outerMorph | self borderColor: ( (self == outerMorph or: [owner notNil and: [owner isSyntaxMorph not]]) ifTrue: [self valueOfProperty: #deselectedBorderColor ifAbsent: [#raised]] ifFalse: [self stdBorderColor] ) ] ! ! !SyntaxMorph methodsFor: 'highlighting' stamp: 'di 5/4/2001 13:22'! unhighlightOwnerBorder "Unhighlight my owner's border" (owner ~~ nil and: [owner isSyntaxMorph]) ifTrue: [owner unhighlightBorder]! ! !SyntaxMorph methodsFor: 'insertion drop zones' stamp: 'di 5/4/2001 13:14'! trackDropZones | hand i localPt insertion insHt ii prevBot nxtHt d c1 c2 ht2 spacer1 spacer2 wid ht1 | hand _ self primaryHand. (hand lastEvent redButtonPressed & hand hasSubmorphs and: [(self hasOwner: hand) not]) ifFalse: [^ self]. insertion _ hand firstSubmorph renderedMorph. insertion isSyntaxMorph ifFalse: [^ self]. insertion isNoun ifFalse: [^ self]. localPt _ self globalPointToLocal: hand position. insHt _ insertion height. "**just use standard line height here" self removeDropZones. "Maybe first check if in right place, then just tweak heights." i _ (ii _ self indexOfMorphAbove: localPt) min: submorphs size-1. prevBot _ i <= 0 ifTrue: [(self innerBounds) top] ifFalse: [(self submorphs at: i) bottom]. nxtHt _ (submorphs isEmpty ifTrue: [insertion] ifFalse: [self submorphs at: i+1]) height. d _ ii > i ifTrue: [nxtHt "for consistent behavior at bottom"] ifFalse: [0 max: (localPt y - prevBot min: nxtHt)]. "Top and bottom spacer heights cause continuous motion..." c1 _ Color transparent. c2 _ Color transparent. ht2 _ d*insHt//nxtHt. ht1 _ insHt - ht2. wid _ 100 min: owner width - 10. (spacer1 _ BorderedMorph newBounds: (0@0 extent: wid@ht1) color: (ht1 > (insHt//2) ifTrue: [c1] ifFalse: [c2])) borderWidth: 1; borderColor: spacer1 color. self privateAddMorph: spacer1 atIndex: (i+1 max: 1). (spacer2 _ BorderedMorph newBounds: (0@0 extent: wid@ht2) color: (ht2 > (insHt//2+1) ifTrue: [c1] ifFalse: [c2])) borderWidth: 1; borderColor: spacer2 color. spacer1 setProperty: #dropZone toValue: true. spacer2 setProperty: #dropZone toValue: true. self privateAddMorph: spacer2 atIndex: (i+3 min: submorphs size+1). self fullBounds. "Force layout prior to testing for cursor containment" "Maintain the drop target highlight -- highlight spacer if hand is in it." {spacer1. spacer2} do: [:spacer | (spacer containsPoint: localPt) ifTrue: [spacer color: self dropColor. self borderColor = self dropColor ifTrue: [self borderColor: self stdBorderColor]]]. "If no submorph (incl spacers) highlighted, then re-highlight the block." ((self wantsDroppedMorph: insertion event: hand lastEvent) and: [(self submorphs anySatisfy: [:m | m containsPoint: localPt]) not]) ifTrue: [self borderColor: self dropColor] ! ! SyntaxMorph removeSelector: #aJunkMethod:event:! SyntaxMorph removeSelector: #hideCaret!