'From etoys4.0 of 9 October 2008 [latest update: #2254] on 24 August 2009 at 5:36:28 pm'!
"Change Set:		projectInfoPopUps-sw
Date:			24 August 2009
Author:			Scott Wallace

Changes to the project-info dialog in support of the 'showcase'.

-  'Sub-Category' removed.
-  'Category' appears as 'Subject'.
-  Subject, Target Age, and Region are added as pop-ups.
-  Choices for Subject, Target Age, and Region, and corresponding codes, obtained from web-site where possible.
-  Project manifest now includes Age, and Region info.  Subject is represented as before as projectcategory. The codes are strings of digits, e.g. '554' as a Subject code means 'Language Arts'.
-  Names of fields are presented to the user in localized form.
-  Values of pop-up fields are presented to the user in localized form."!

EToyProjectRenamerMorph subclass: #EToyProjectDetailsMorph
	instanceVariableNames: 'projectDetails '
	classVariableNames: 'RegionTriplets SubjectTriplets AgeTriplets '
	poolDictionaries: ''
	category: 'Morphic-Experimental'!

!EToyProjectDetailsMorph methodsFor: 'classifications' stamp: 'sw 8/7/2009 20:41'!
ageTriplets
	"Answer a list of the triplets characterizing the 'age' categories; each triplet is of the form
		(<numeric code> <string code> <english version>)"

	^ AgeTriplets ifNil: [AgeTriplets := self class defaultAgeTriplets]! !

!EToyProjectDetailsMorph methodsFor: 'classifications' stamp: 'sw 8/7/2009 20:39'!
regionTriplets
	"Answer a list of triplets of the form (numberCode stringCode englishName) for the regions."

	^ RegionTriplets ifNil: [RegionTriplets := self class defaultRegionTriplets]! !

!EToyProjectDetailsMorph methodsFor: 'classifications' stamp: 'sw 8/7/2009 21:37'!
subjectTriplets
	"Answer a list of triplets characterizing the subjects in the current taxonomy."

	^ SubjectTriplets ifNil: [SubjectTriplets := self class defaultSubjectTriplets]! !

!EToyProjectDetailsMorph methodsFor: 'initialization' stamp: 'sw 8/12/2009 11:43'!
rebuild
	"Rebuild the receiver from scratch."

	| bottomButtons header toAdd |
	self removeAllMorphs.
	header := self addARow: {
		self lockedString: 'Please describe this project' translated.
	}.
	header color: ScriptingSystem baseColor.
	self addARow: {
		self lockedString: 'Project Name' translated.
		self inAColumnForText: {self fieldForProjectName}
	}.
	self expandedFormat ifTrue: [
		self fieldToDetailsMappings do: [ :each |
			toAdd := (each size < 5 or: [each fifth = #text])
				ifTrue:
					[self genericTextFieldNamed: each first]
				ifFalse:
					[self popUpEntryNamed: each first menuTitle: each third].

			self addARow: {
				self lockedString: each third translated.
				self inAColumnForText: {toAdd height: each fourth}
			}.
		].
	].
	bottomButtons _ self expandedFormat ifTrue: [
		{
			self okButton.
			self cancelButton.
		}
	] ifFalse: [
		{
			self okButton.
			self expandButton.
			self cancelButton.
		}
	].
	self addARow: bottomButtons.
	self fillInDetails.! !

!EToyProjectDetailsMorph methodsFor: 'project details' stamp: 'sw 8/8/2009 02:50'!
copyOutDetails
	"Prepare a new Dictionary holding project-info details as noted in the dialog."

	| newDetails elements item |
	newDetails := Dictionary new.
	self fieldToDetailsMappings do: [ :each |
		namedFields at: each first ifPresent: [ :field |
				(#('age' 'subject' 'region') includes: each first)
					ifFalse:
							[newDetails at: each second put: field contents string]
						ifTrue:
							[elements := self choicesFor: each first.  "triplet"
							item := elements detect: [:el | el third = field contents string translated] ifNone: [nil].
							item ifNotNil:
								[newDetails at: each second put: item first]]]].


	namedFields at: 'projectname' ifPresent: [ :field |
		newDetails at: 'projectname' put: field contents string withBlanksTrimmed].

	^ newDetails! !

!EToyProjectDetailsMorph methodsFor: 'project details' stamp: 'sw 8/12/2009 11:35'!
fieldToDetailsMappings
	"Answer an array describing, top to bottom, the details of each element.
		Each element is a tuple consisting of:
			1.	field name (internal)
			2.	key in the project-details dictionary
			3.	text (english version) to be shown in the entry's label at left.
			4. vertical space to allow
			5. entry type: (if missing, text is implied)
				#text --> editable text field
				#popUp --> pop-up of choices"
	^{
		{#description. 'projectdescription'. 'Description' translatedNoop. 100}. 
		{#author. 'projectauthor'. 'Author' translatedNoop. 20}.
		{#subject.  'projectcategory'.  'Subject' translatedNoop.  20.  #popUp}.
		{#age.		'projectage'.	'Target Age' translatedNoop.  20.  #popUp}.
		{#region.		'projectregion'.	'Region' translatedNoop.  20.  #popUp}.	
		{#keywords. 'projectkeywords'. 'Tags' translatedNoop. 20}
	}
! !

!EToyProjectDetailsMorph methodsFor: 'project details' stamp: 'sw 8/8/2009 03:38'!
fillInDetails
	"Given that the receiver's namedFields is already set up, give each such field its appropriate initial value."

	| elements item |
	theProject ifNotNil:
		[namedFields at: 'projectname' ifPresent:
			[:field | field contentsWrapped: theProject name]].

	projectDetails ifNotNil:
		[self fieldToDetailsMappings do: [ :tuple |
			namedFields at: tuple first ifPresent: [ :field |
				projectDetails at: tuple second ifPresent: [ :data |
					elements := self choicesFor: tuple first.
					elements
						ifNil:
							[field contentsWrapped: data]
						ifNotNil:
							[item := elements detect: [:el | el first = data] ifNone: [nil].
							item ifNotNil:
								[field contentsWrapped: item third translated]
							ifNil:
								[field contentsWrapped: '(none)' translated]]]]]]! !

!EToyProjectDetailsMorph methodsFor: 'utilities' stamp: 'sw 8/8/2009 03:09'!
choicesFor: aSymbol
	"Answer the list of choices to offer for the given symbol, which will be subject, age, or region.  Answer nil if the symbol provided is one without enumerated choices."
	
	aSymbol = #subject ifTrue:
		[^ self subjectTriplets].

	aSymbol = #age ifTrue:
		[^ self ageTriplets].

	aSymbol = #region ifTrue:
		[^ self regionTriplets].

	^ nil! !

!EToyProjectDetailsMorph methodsFor: 'utilities' stamp: 'sw 8/12/2009 13:54'!
doPopUp: aSymbol event: anEvent for: aTextMorph
	"The user clicked on a pop-up field in the project-info dialog.  Put up the pop-up of choices."

	| aMenu aTitle |
	aMenu := MenuMorph new defaultTarget: self.
	aTitle := aTextMorph valueOfProperty: #menuTitle.
	aTitle ifNotNil:
		[aMenu addTitle: aTitle translated].
	aMenu add: '(optional: click to choose)' translated target: self selector: #setInfoField:to: argumentList: {aSymbol asString. '(optional: click to choose)'}.
	aMenu addLine.
	(self choicesFor: aSymbol) do:
		[:aChoice |
			aMenu add: aChoice third translated target: self selector: #setInfoField:to: argumentList: {aSymbol. aChoice first}].
	aMenu popUpInWorld! !

!EToyProjectDetailsMorph methodsFor: 'utilities' stamp: 'sw 8/12/2009 11:36'!
popUpEntryNamed: aString
	"Answer a text morph that will serve as a pop-up"

	| newField |
	newField := StaticTextMorph new beAllFont: self myFont;
				 extent: 400 @ 20;
				 contentsWrapped: '(optional: click to choose)' translated.
	namedFields at: aString put: newField.
	newField on: #click send: #doPopUp:event:for: to: self withValue: aString.
	^ newField! !

!EToyProjectDetailsMorph methodsFor: 'utilities' stamp: 'sw 8/12/2009 11:42'!
popUpEntryNamed: aString menuTitle: titleInEnglish
	"Answer a text morph that will serve as a pop-up.  The first parameter is the key in the named-fields dictionary, the second is the title (in english) to give to the menu."

	| newField |
	newField := StaticTextMorph new beAllFont: self myFont;
				 extent: 400 @ 20;
				 contentsWrapped: '(optional: click to choose)' translated.
	newField setProperty: #menuTitle toValue: titleInEnglish.
	namedFields at: aString put: newField.
	newField on: #click send: #doPopUp:event:for: to: self withValue: aString.
	^ newField! !

!EToyProjectDetailsMorph methodsFor: 'utilities' stamp: 'sw 8/8/2009 03:40'!
setInfoField: aFieldName to: aValue
	"Install a value into an info field of the dialog.  Textual fields are filled literally, but enumerated fields (subject, region, etc.) are represented by codes which get mapped into (translated) text to display."

	| newValue choices |
	newValue := aValue.

	choices := self choicesFor: aFieldName.
	choices ifNotNil:  "i.e. one of the fields with enumerated values"
		[(choices detect: [:c | c first = aValue] ifNone: [nil]) ifNotNilDo:
			[:item | newValue := item third translated]].

	(namedFields at: aFieldName) contentsWrapped: newValue
	! !


!EToyProjectDetailsMorph class methodsFor: 'as yet unclassified' stamp: 'sw 8/12/2009 13:54'!
getFullInfoFor: aProject ifValid: aBlock expandedFormat: expandedFormat
	"Obtain project info for the project by putting up a dialog-box showing current values for the various project-info variables and allowing the user to change the data."

	| me |
	self updateTripletsFromWebSite.
	(me _ self basicNew)
		expandedFormat: expandedFormat;
		project: aProject
		actionBlock: [ :x | 
			aProject world setProperty: #ProjectDetails toValue: x.
			x at: 'projectname' ifPresent: [ :newName | 
				aProject renameTo: newName.
			].
			me delete.
			aBlock value.
		];

		initialize;
		becomeModal;
		beSticky;
		openCenteredInWorld! !

!EToyProjectDetailsMorph class methodsFor: 'classification information' stamp: 'sw 8/24/2009 17:36'!
updateTripletsFromWebSite
	"Attempt to update the age-range, subject, and region triplets stored in the image by referring to the latest versions on the web site."

	| url result |
	url := 'http://squeakland.org/subjectCatList'.
	[result := (self linesIn: (((HTTPSocket httpGet: url args: #() user: '' passwd: '')) contents copyReplaceAll: String lf with: String cr)) collect: [:l | self csvLineQuotedDecodedFor: l]] on: Error do:
		[:ex | ^ self].
	(result isNil or: [result size < 2]) ifTrue: [^ self].
	SubjectTriplets := result.

	url := 'http://squeakland.org/ageCatList'.
	[result := (self linesIn: (((HTTPSocket httpGet: url args: #() user: '' passwd: '')) contents copyReplaceAll: String lf with: String cr)) collect: [:l | self csvLineQuotedDecodedFor: l]] on: Error do:
		[:ex | ^ self].
	(result isNil or: [result size < 2]) ifTrue: [^ self].
	AgeTriplets := result.

	url := 'http://squeakland.org/regionCatList'.
	[result := (self linesIn: (((HTTPSocket httpGet: url args: #() user: '' passwd: '')) contents copyReplaceAll: String lf with: String cr)) collect: [:l | self csvLineQuotedDecodedFor: l]] on: Error do:
		[:ex | ^ self].
	(result isNil or: [result size < 2]) ifTrue: [^ self]..
	RegionTriplets := result

"
EToyProjectDetailsMorph updateTripletsFromWebSite
"! !

!EToyProjectDetailsMorph class methodsFor: 'utilities' stamp: 'sw 8/7/2009 14:53'!
csvLineQuotedDecodedFor: aString
	"Given that the string provided consists of items delimited by double-quotes and separated by commas, answer an array containing the individual items with quotes removed."

	| openQuoteHanging readStream elementStream char |
	openQuoteHanging := false.

	^ Array streamContents: [:writeStream |
		readStream := aString readStream.
		elementStream := WriteStream on: ''.
		[readStream atEnd] whileFalse:
			[char := readStream next.
			char = $"
				ifTrue:
					[openQuoteHanging
						ifTrue:
							[writeStream nextPut: elementStream contents.
							elementStream := WriteStream on: ''.
							openQuoteHanging := false]
						ifFalse:
							[openQuoteHanging := true]]
				ifFalse:
					[openQuoteHanging ifTrue:
						[elementStream nextPut: char]]]]
				
"
(((HTTPSocket httpGet: 'http://squeakland.org/subjectCatList' args: #() user: '' passwd: '')) contents copyReplaceAll: String lf with: String cr) lines collect: [:l | EToyProjectDetailsMorph csvLineQuotedDecodedFor: l]
"! !

!EToyProjectDetailsMorph class methodsFor: 'utilities' stamp: 'sw 8/7/2009 21:34'!
linesIn: aString
	"Answer an array whose elements are strings constituting the lines in the input string."

	^ Array streamContents: [:aStream |
		aString linesDo:
			[: aLine | aStream nextPut: aLine]]

"
EToyProjectDetailsMorph linesIn: 'Fred
the
	Bear'
"! !

!EToyProjectDetailsMorph class methodsFor: 'classification defaults' stamp: 'sw 8/7/2009 22:12'!
defaultAgeTriplets
	"Answer a default set of triplets characterizing the Age classifications"

	^  #(
	('556' 'showcase : by age : 6 to 8' 'Ages 6 to 8')
	('558' 'showcase : by age : 9 to 11' 'Ages 9 to 11')
	('559' 'showcase : by age : 12 to 14' 'Ages 12 to 14')
	('560' 'showcase : by age : 15 to 18' 'Ages 15 to 18') )! !

!EToyProjectDetailsMorph class methodsFor: 'classification defaults' stamp: 'sw 8/24/2009 16:10'!
defaultRegionTriplets
	"Answer default triplets for the region codes"

	^  #(
	('619' 'showcase : by region : Antarctica' 'Antarctica')
	('620' 'showcase : by region : Asia' 'Asia') 
	('621' 'showcase : by region : Australia' 'Australia') 
	('623' 'showcase : by region : Caribbean' 'Caribbean')
	('622' 'showcase : by region : Central America' 'Central America')
	('624' 'showcase : by region : Europe' 'Europe') 
	('625' 'showcase : by region : North America' 'North America')
	('626' 'showcase : by region : Oceania' 'Oceania') 
	('627' 'showcase : by region : South America' 'South America') 
)

"
EToyProjectDetailsMorph defaultRegionTriplets
"! !

!EToyProjectDetailsMorph class methodsFor: 'classification defaults' stamp: 'sw 8/7/2009 22:12'!
defaultSubjectTriplets
	"Answer a default set of triplets characterizing the Subject classifications"

	^  #(
	('554' 'showcase : by subject : language arts' 'Language Arts')
	('553' 'showcase : by subject : mathemetics' 'Mathematics')
	('555' 'showcase : by subject : science' 'Science')
	('860' 'showcase : by subject : social studies' 'Social Studies') 
	('861' 'showcase : by subject : music' 'Music')
	('862' 'showcase : by subject : visual arts' 'Visual Arts')
	('863' 'showcase : by subject : health' 'Health'))! !

!EToyProjectDetailsMorph class methodsFor: 'classification defaults' stamp: 'sw 8/7/2009 21:44'!
restoreDefaultTriplets
	"Restore the defaults obtained from cold hard code."

	RegionTriplets := self defaultRegionTriplets.
	AgeTriplets := self defaultAgeTriplets.
	SubjectTriplets := self defaultSubjectTriplets

"
EToyProjectDetailsMorph restoreDefaultTriplets
"! !


!EToyProjectQueryMorph methodsFor: 'utilities' stamp: 'sw 8/12/2009 11:47'!
rebuild
	"Rebuild the receiver from scratch."

	| toAdd isText |
	self removeAllMorphs.
	self addARow: {
		self lockedString: 'Enter things to search for' translated.
	}.
	self addARow: {
		self lockedString: 'Project Name' translated.
		self inAColumnForText: {self fieldForProjectName}
	}.
	self fieldToDetailsMappings do: [ :each |
		isText := each size < 5 or: [each fifth = #text].
		self addARow: {
			self lockedString: each third translated.
				toAdd := isText
					ifTrue:
						[self genericTextFieldNamed: each first]
					ifFalse:
						[self popUpEntryNamed: each first menuTitle: each third].

				self inAColumnForText: {toAdd height: each fourth}

		}.
	].

	self addARow: {
		self okButton.
		self cancelButton.
	}.
	self fillInDetails.! !


!HTTPSocket class methodsFor: '*monticello' stamp: 'avi 2/10/2004 14:02'!
httpGet: url args: args user: user passwd: passwd
	| authorization |
	authorization _ (Base64MimeConverter mimeEncode: (user , ':' , passwd) readStream) contents.
	^self 
		httpGet: url args: args accept: '*/*' 
		request: 'Authorization: Basic ' , authorization , CrLf! !


!StaticTextMorph methodsFor: 'event handling' stamp: 'sw 8/7/2009 21:45'!
wouldAcceptKeyboardFocusUponTab
	"Since the receiver is not user-editible by conventional means, refuse to give it the selection upon tab."

	^ false! !

!StaticTextMorph methodsFor: 'e-toy support' stamp: 'sw 8/8/2009 03:03'!
printOn: aStream
	"Print the receiver on a stream."

	super printOn: aStream.
	aStream nextPutAll: ': '.
	self contents asString printOn: aStream! !

!StaticTextMorph methodsFor: 'drawing' stamp: 'sw 8/7/2009 21:45'!
drawNullTextOn: aCanvas
	"Make null text frame visible"

	aCanvas isPostscriptCanvas ifFalse:
		[aCanvas fillRectangle: bounds color: Color transparent]! !

EToyProjectRenamerMorph subclass: #EToyProjectDetailsMorph
	instanceVariableNames: 'projectDetails'
	classVariableNames: 'AgeTriplets RegionTriplets SubjectTriplets'
	poolDictionaries: ''
	category: 'Morphic-Experimental'!

!EToyProjectDetailsMorph reorganize!
('classifications' ageTriplets regionTriplets subjectTriplets)
('expand' doExpand expandButton expandedFormat expandedFormat:)
('initialization' project:actionBlock: rebuild)
('project details' copyOutDetails fieldToDetailsMappings fillInDetails projectDetails:)
('utilities' choicesFor: doOK doPopUp:event:for: popUpEntryNamed: popUpEntryNamed:menuTitle: setInfoField:to:)
!