DropZoneMorph 2
Last updated at 5:38 am UTC on 9 May 2018
Updated version of DropZoneMorph, by Bob Arning
May 3, 2018
can create drop zones (with thumbnail) for all morphic projects, with the extra feature that dropped morphs are centered in the destination world to make them easy to find.
'From Squeak5.1 of 23 August 2016 [latest update: #16548] on 3 May 2018 at 10:15:24 am'!
"Change Set: DropZone
Date: 2 May 2018
Author: Bob Arning
DropZoneMorph is a place to drop things to execute a user-supplied action. Examples in class comment"!
Morph subclass: #DropZoneMorph
instanceVariableNames: 'label action '
classVariableNames: ''
poolDictionaries: ''
category: 'Morphic-Widgets'!
!DropZoneMorph commentStamp: 'raa 5/3/2018 10:11' prior: 0!
DropZoneMorph new
openLabel: 'explore'
action: [ :m | m explore. #reject]
DropZoneMorph new
openLabel: 'to project unnamed'
action: [ :m | (Project named: 'Unnamed') world addMorph: m.]
DropZoneMorph new
openLabel: 'take a picture'
action: [ :m | m imageForm asMorph openInWorld. #reject];
addMorphBack: (Morph new color: Color green)
DropZoneMorph makeAllProjectsDropper!
]style[(367 22),c000126126!
!DropZoneMorph methodsFor: 'as yet unclassified' stamp: 'raa 5/2/2018 07:31'!
acceptDroppingMorph: aMorph event: evt
self halt.! !
!DropZoneMorph methodsFor: 'as yet unclassified' stamp: 'raa 5/2/2018 11:55'!
openLabel: l action: a
label _ l.
action _ a.
self
layoutPolicy: TableLayout new;
rubberBandCells: true;
listDirection: #topToBottom;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
extent: 1@1;
borderWidth: 0;
color: Color paleBlue;
addMorph: (StringMorph contents: label) lock.
self openInWorld! !
!DropZoneMorph methodsFor: 'as yet unclassified' stamp: 'raa 5/2/2018 07:58'!
rejectDropEvent: anEvent
anEvent wasHandled: true.
(action value: anEvent contents) = #reject ifTrue: [
anEvent contents rejectDropMorphEvent: anEvent.
].
! !
!DropZoneMorph methodsFor: 'as yet unclassified' stamp: 'raa 5/2/2018 07:59'!
wantsDroppedMorph: aMorph event: evt
self halt.
! !
!DropZoneMorph class methodsFor: 'as yet unclassified' stamp: 'raa 5/3/2018 10:14'!
makeAllProjectsDropper
"
self makeAllProjectsDropper
"
| wrapper |
wrapper _ AlignmentMorph newColumn.
Project allProjects do: [ :p |
p isMorphic ifTrue: [
wrapper addMorphBack: (
DropZoneMorph new
openLabel: 'to ',p name
action: [ :m |
p world addMorph: m.
m center: p world center "make new morphs easier to find"
];
addMorphBack: (p thumbnail ifNil: [Morph new]) asMorph
)
].
].
wrapper openInWorld.! !
