'From etoys2.1 of 26 July 2007 [latest update: #1556] on 16 August 2007 at 10:06:41 pm'!
"Change Set:		projectViewIssues-sw
Date:			17 August 2007
Author:			Scott Wallace

TRAC 2888:  Makes project-view icons obey the acceptDrops flag governed in the halo menu.
Clean up wording of project-view dismiss interactions.

This addresses the issue that often it is quite inconvenient and inappropriate for a project thumbnail to accept such drops.  By default project-views will, by default, accept drops, but this provides a way that the author of a project can control whether or not drops are accepted."!


!Project methodsFor: 'release' stamp: 'sw 8/16/2007 11:52'!
okToChange
	"Answer whether the window in which the project is housed can be dismissed -- which is destructive. We never clobber a project without confirmation"

	| ok is list |
	self subProjects size  >0 ifTrue:
		[self inform: 
('The project {1}
contains sub-projects.  You must remove these
explicitly before removing their parent.' translated format:{self name}).
		^ false].
	ok _ world isMorph not and: [world scheduledControllers size <= 1].
	ok ifFalse: [self isMorphic ifTrue:
		[self parent == CurrentProject 
			ifFalse: [^ true]]].  "view from elsewhere.  just delete it."
	ok _ (self confirm:
('Really delete the project
{1}
and all its contents?' translated format:{self name})).
		
	ok ifFalse: [^ false].

	world isMorph ifTrue:
		[Smalltalk at: #WonderlandCameraMorph ifPresent:[:aClass |
			world submorphs do:   "special release for wonderlands"
						[:m | (m isKindOf: aClass)
								and: [m getWonderland release]]].
			"Remove Player classes and metaclasses owned by project"
			is _ ImageSegment new arrayOfRoots: (Array with: self).
			(list _ is rootsIncludingPlayers) ifNotNil:
				[list do: [:playerCls | 
					(playerCls respondsTo: #isMeta) ifTrue:
						[playerCls isMeta ifFalse:
							[playerCls removeFromSystemUnlogged]]]]].

	self removeChangeSetIfPossible.
	"do this last since it will render project inaccessible to #allProjects and their ilk"
	ProjectHistory forget: self.
	Project deletingProject: self.
	^ true
! !


!ProjectViewMorph methodsFor: 'dropping/grabbing' stamp: 'sw 8/16/2007 11:37'!
wantsDroppedMorph: aMorph event: evt
	"Answer if the receiver would accept a drop of a given morph."

	"If drop-enabled not set, answer false"
	(super wantsDroppedMorph: aMorph event: evt) ifFalse: [^ false].

	"If project not present, not morphic, or not initialized, answer false"
	self isTheRealProjectPresent ifFalse: [^ false].
	project isMorphic ifFalse: [^ false].
	project world viewBox ifNil: [^ false].

	^ true! !

!ProjectViewMorph methodsFor: 'initialization' stamp: 'sw 8/16/2007 11:51'!
dismissViaHalo
	"The user clicked on the dismiss icon on the halo."

	| choice |
	project ifNil: [^ self delete]. "no current project"
	choice := (PopUpMenu labelArray:{
		'yes - delete icon and delete the project' translated.
		'no - delete icon but keep the project' translated.
		'cancel - do not delete anything' translated.  
	}) startUpWithCaption: ('Do you really want to delete the
project named {1}
and all its contents?' translated format: {project name printString}).
	choice = 1 ifTrue: [^ self expungeProject].
	choice = 2 ifTrue: [^ self delete]! !

!ProjectViewMorph methodsFor: 'initialization' stamp: 'sw 8/16/2007 11:28'!
initialize
	"Initialize the receiver."

	super initialize.
	"currentBorderColor _ Color gray."
	self addProjectNameMorphFiller.
	self enableDragNDrop: true.
	self isOpaque: true.
! !

!ProjectViewMorph methodsFor: 'layout' stamp: 'sw 8/16/2007 11:40'!
acceptDroppingMorph: morphToDrop event: evt
	"Accept -- in a custom sense here -- a morph dropped on the receiver."

	| myCopy smallR |

	(self isTheRealProjectPresent) ifFalse: [
		^morphToDrop rejectDropMorphEvent: evt.		"can't handle it right now"
	].
	(morphToDrop isKindOf: NewHandleMorph) ifTrue: [	"don't send these"
		^morphToDrop rejectDropMorphEvent: evt.
	].
	self dropEnabled ifFalse:
		[^ morphToDrop rejectDropMorphEvent: evt].

	self eToyRejectDropMorph: morphToDrop event: evt.		"we will send a copy"
	myCopy _ morphToDrop veryDeepCopy.	"gradient fills require doing this second"
	smallR _ (morphToDrop bounds scaleBy: image height / Display height) rounded.
	smallR _ smallR squishedWithin: image boundingBox.
	image getCanvas
		paintImage: (morphToDrop imageForm scaledToSize: smallR extent)
		at: smallR topLeft.
	myCopy openInWorld: project world

! !