2.0 Project Reading 1.cs

'From Squeak4.5 of 19 February 2014 [latest update: #13680] on 1 November 2015 at 7:14:47 pm'!

!ExpressionArgMorph methodsFor: 'accessing'!
defaultValue: t1 
	self isNumberExpression
		ifTrue: [self
				numExpression: (t1 isNumber
						ifTrue: [t1]
						ifFalse: [Number
								readFrom: t1
								ifFail: [' ']])]
		ifFalse: [self stringExpression: t1 asString]! !


!ScratchFileChooserDialog methodsFor: 'initialization'!
createScratchFileChooserFor: t1 saving: t2 
	| t3 t4 t5 t6 |
	scratchFrame := t1.
	readingScratchFile := t2 not.
	list := ScratchFilePicker new extensions: #(#scratch #sb #sb2 ).
	mainColumn addMorphBack: list.
	t2
		ifFalse: [self title: 'Open Project'.
			list scratchInfoClient: self].
	t3 := ScratchFrameMorph getFont: #FileChooserLabel.
	t4 := ScratchFrameMorph getFont: #FileChooserContents.
	t5 := ScratchFrameMorph getFont: #FileChooserComment.
	t2
		ifTrue: [self title: 'Save Project'.
			newFileTitle := StringMorph contents: 'New Filename:' localized , ' ' font: t3.
			newFileTitle
				color: (Color gray: 0.3).
			newFileName := StringFieldMorph new contents: scratchFrame projectName;
						 client: self;
						 font: t4;
						
						color: (Color
								r: 211 / 255
								g: 214 / 255
								b: 216 / 255);
						 width: 180.
			tabFields add: newFileName.
			newTitleBin addMorphBack: newFileTitle;
				 addMorphBack: newFileName.
			ScratchTranslator isRTL
				ifTrue: [newTitleBin submorphs reversed
						do: [:t7 | 
							t7 delete.
							newTitleBin addMorphBack: t7]].
			mainColumn addMorphBack: newTitleBin].
	t6 := AlignmentMorph newColumn wrapCentering: #center;
				 color: Color transparent.
	thumbnailFrameMorph := ImageFrameMorph new
				initThumbnailFrameFromForm: (ScratchFrameMorph skinAt: #dialogThumbnailFrame).
	thumbnailFrameMorph extent: 170 @ 130.
	t6 addMorph: thumbnailFrameMorph.
	thumbnailMorph := ImageMorph new
				image: (Form extent: 160 @ 120 depth: 1).
	thumbnailFrameMorph addMorphFront: thumbnailMorph.
	fileInfoColumn addMorphBack: t6.
	authorLabelMorph := StringMorph contents: 'Project author:' localized font: t3.
	authorLabelMorph
		color: (Color gray: 0.3).
	fileInfoColumn addMorphBack: authorLabelMorph.
	t2
		ifTrue: [authorMorph := StringFieldMorph new useStringFieldFrame; contents: ''; font: t4.
			tabFields add: authorMorph]
		ifFalse: [authorMorph := StringFieldMorph new color: Color transparent;
						 borderWidth: 0;
						 contents: '';
						 isEditable: false;
						 font: t4].
	fileInfoColumn addMorphBack: authorMorph.
	commentLabelMorph := StringMorph contents: 'About this project:' localized font: t3.
	commentLabelMorph color: authorLabelMorph color.
	fileInfoColumn addMorphBack: commentLabelMorph.
	commentMorph := ScrollingStringMorph new borderWidth: 0;
				 contents: '';
				 font: t5;
				 extent: 210 @ 110.
	t2
		ifTrue: [commentMorph
				backForm: (ScratchFrameMorph skinAt: #stringFieldFrame).
			tabFields add: commentMorph]
		ifFalse: [commentMorph isEditable: false].
	fileInfoColumn addMorphBack: commentMorph.
	fileInfoColumn addMorphBack: buttonRow.
	t2
		ifTrue: [self scratchInfo: scratchFrame projectInfo.
			thumbnailMorph image: scratchFrame workPane thumbnailForm.
			t1 loginName size > 0
				ifTrue: [authorMorph contents: t1 loginName]
				ifFalse: [authorMorph contents: t1 author]].
	fileInfoColumn addMorphBack: buttonRow! !


!ScratchFrameMorph methodsFor: 'file read/write'!
decodeFromZipFile: t1 
	| t2 t3 t4 t5 t6 t8 |
	t3 := Dictionary new.
	t2 := ZipArchive new.
	t2 readFrom: t1.
	t2 members
		do: [:t9 | 
			t8 := t9 fileName.
			(t8 endsWith: '.gif')
					| (t8 endsWith: '.jpg')
					| (t8 endsWith: '.png')
				ifTrue: [t3
						at: (t8 allButLast: 4) asInteger
						put: (Form fromBinaryStream: t9 contentStream)].
			(t8 endsWith: '.json')
				ifTrue: [t6 := (t9 contentStreamFromEncoding: 'utf-8') text]].
	t6
		ifNil: [^ nil].
	(t4 := Json readFrom: t6)
		ifError: [^ nil].
	t4 isDictionary
		ifFalse: [^ nil].
	t4 children
		ifNotNil: [t5 := ScratchStageMorph new.
			t5
				readJSON: t4
				images: t3
				sounds: nil].
	^ t5! !

!ScratchFrameMorph methodsFor: 'file read/write'!
extractProjectFrom: t1 
	| t2 t3 t4 |
	t2 := ReadStream on: t1.
	(ZipArchive isZipArchive: t2)
		ifTrue: [t3 := 3.
			t4 := self decodeFromZipFile: t2]
		ifFalse: [t2 position: 0.
			t3 := ObjStream scratchFileVersionFrom: (t2 next: 10) asString.
			t3 = 0
				ifTrue: [t2 position: 0.
					t4 := ObjStream new readObjFrom: t2 showProgress: true].
			t3 = 1 | (t3 = 2)
				ifTrue: [t2 skip: t2 uint32.
					t4 := ObjStream new readObjFrom: t2 showProgress: true]].
	t4 class = ScratchStageMorph
		ifFalse: [t3 > 3
				ifTrue: [self error: 'Project created by a later version of Scratch']
				ifFalse: [self error: 'Problem reading project.'].
			^ nil].
	ScriptableScratchMorph buildBlockSpecDictionary.
	t4
		allMorphsDo: [:t5 | (t5 isKindOf: ScriptableScratchMorph)
				ifTrue: [t5 convertStacksToTuples.
					t5 convertTuplesToStacks]].
	^ t4! !

!ScratchFrameMorph methodsFor: 'file read/write'!
importScratchProject
	| t1 |
	self closeMediaEditorsAndDialogs
		ifFalse: [^ self].
	self stopAll.
	t1 := ScratchFileChooserDialog
				chooseExistingFileType: #project
				extensions: #(#scratch #sb #sb2 )
				title: 'Import Project'.
	t1
		ifNil: [^ self].
	self importSpriteOrProject: t1! !

!ScratchFrameMorph methodsFor: 'file read/write'!
nameFromFileName: t1 
	| t2 |
	<pragma: #i18nIssue>
	t2 := t1.
	(t2 asLowercase endsWith: '.scratch')
		ifTrue: [t2 := t2 copyFrom: 1 to: t2 size - 8].
	(t2 asLowercase endsWith: '.sb')
		ifTrue: [t2 := t2 copyFrom: 1 to: t2 size - 3].
	(t2 asLowercase endsWith: '.sb2')
		ifTrue: [t2 := t2 copyFrom: 1 to: t2 size - 4].
	^ t2! !


!ScriptableScratchMorph methodsFor: 'blocks'!
blockFromTuple: t1 receiver: t2 
	| t3 t4 t5 t6 t7 t8 t9 |
	t3 := t1 first asSymbol.
	(#(#readVariable #changeVariable ) includes: t3)
		ifTrue: [^ self variableBlockFromTuple: t1 receiver: t2].
	#contentsOfList: = t3
		ifTrue: [^ ListContentsBlockMorph new color: ScriptableScratchMorph listBlockColor;
				 receiver: t2;
				 commandSpec: t1 second;
				 selector: #contentsOfList:].
	(#(#EventHatMorph #KeyEventHatMorph #MouseClickEventHatMorph #WhenHatBlockMorph ) includes: t3)
		ifTrue: [t6 := self hatBlockFromTuple: t1 receiver: t2.
			t6 isWhenHatMorph
				ifTrue: [t6 color: Color red].
			^ t6].
	#scratchComment = t3
		ifTrue: [t6 := ScratchCommentMorph new.
			t1 size > 1
				ifTrue: [t6 commentMorph
						contents: (t1 at: 2)].
			t1 size > 2
				ifTrue: [(t1 at: 3)
						ifFalse: [t6 toggleShowing]].
			t1 size > 3
				ifTrue: [t6
						width: (t1 at: 4)].
			t1 size > 4
				ifTrue: [t6
						anchor: (self
								blockWithID: (t1 at: 5))].
			^ t6].
	#comment: = t3
		ifTrue: [t6 := CommentBlockMorph new.
			t1 size > 1
				ifTrue: [t6
						comment: (t1 at: 2)].
			t1 size > 2
				ifTrue: [(t1 at: 3)
						ifFalse: [t6 toggleShowing]].
			t6
				color: (Color
						r: 0.8
						g: 0
						b: 0).
			^ t6].
	(#(#whenGreenFlag #whenIReceive #whenClicked #whenKeyPressed #setVar:to: #changeVar:by: #startScene #nextScene #% ) includes: t3)
		ifTrue: [t6 := self scratch2BlockFromTuple: t1 receiver: t2.
			t6 isArray
				ifFalse: [^ t6].
			t4 := t6 at: 1.
			t6 := t6 at: 2]
		ifFalse: [t4 := BlockSpecDict
						at: t3
						ifAbsent: [].
			t4
				ifNil: [^ t2 blockFromSpec: #('undefined' #- #undefined ) color: Color red].
			t5 := BlockColorDict
						at: t3
						ifAbsent: [Color red].
			t6 := t2 blockFromSpec: t4 color: t5].
	t6 isCommandBlockMorph
		ifTrue: [t7 := t6 argumentCount min: t1 size - 1.
			1
				to: t7
				do: [:t10 | 
					((#(#+ #- #/ #* #= ) includes: t6 selector)
							and: [ScratchTranslator isRTLMath])
						ifTrue: [t8 := t1 at: t7 + 1 - (t10 - 1)]
						ifFalse: [t8 := t1 at: t10 + 1].
					(t8 isKindOf: Array)
						ifTrue: [(t8 size = 1
									and: [t8 first isKindOf: Array])
								ifTrue: [t8 := t8 first].
							t9 := self blockFromTuple: t8 receiver: t2.
							t6
								replaceArgMorph: (t6 argumentAt: t10)
								by: t9]
						ifFalse: [(t6 argumentAt: t10)
								defaultValue: t8]].
			t6 isCBlockMorph
				ifTrue: [t1 last isArray
						ifTrue: [t6
								firstBlockList: (self stackFromTupleList: t1 last receiver: t2)]].
			t6 isIfElseBlockMorph
				ifTrue: [t8 := t1 at: t1 size - 1.
					t8 isArray
						ifTrue: [t6
								trueBlock: (self stackFromTupleList: t8 receiver: t2)].
					t8 := t1 at: t1 size.
					t8 isArray
						ifTrue: [t6
								falseBlock: (self stackFromTupleList: t8 receiver: t2)]].
			t6 isReporterBlockMorph
				ifTrue: [((t4 at: 2)
							includes: $b)
						ifTrue: [t6 isBoolean: true]]].
	^ t6! !

!ScriptableScratchMorph methodsFor: 'blocks'!
hatBlockFromTuple: t1 receiver: t2 
	| t3 t4 t5 t6 |
	t3 := Smalltalk at: t1 first asSymbol.
	t4 := t3 new scriptOwner: t2.
	t3 = EventHatMorph
		ifTrue: [t5 := t1 at: 2.
			t5 = 'Scratch-StartClicked'
				ifTrue: [t4 forStartEvent; scriptOwner: t2]
				ifFalse: [t4 eventName: t5]].
	t3 = KeyEventHatMorph
		ifTrue: [t4
				choice: (t1 at: 2)].
	t3 = WhenHatBlockMorph
		ifTrue: [(t1 at: 2)
					~= false
				ifTrue: [t6 := self
								blockFromTuple: (t1 at: 2)
								receiver: t2.
					t4 replaceArgMorph: t4 argMorph by: t6]].
	^ t4! !

!ScriptableScratchMorph methodsFor: 'blocks'!
scratch2BlockFromTuple: t1 receiver: t2 
	| t3 t4 t5 t6 t7 t8 |
	t3 := t1 first asSymbol.
	#whenGreenFlag = t3
		ifTrue: [^ EventHatMorph new forStartEvent; scriptOwner: t2].
	#whenIReceive = t3
		ifTrue: [^ EventHatMorph new scriptOwner: t2;
				
				eventName: (t1 at: 2)].
	#whenClicked = t3
		ifTrue: [^ MouseClickEventHatMorph new scriptOwner: t2].
	#whenKeyPressed = t3
		ifTrue: [^ KeyEventHatMorph new scriptOwner: t2;
				
				choice: (t1 at: 2)].
	(#(#setVar:to: #changeVar:by: ) includes: t3)
		ifTrue: [t8 := #(#changeVariable 'a' #changeVar:by: 1 ).
			t8
				at: 2
				put: (t1 at: 2).
			t8 at: 3 put: t3.
			t8
				at: 4
				put: (t1 at: 3).
			^ self variableBlockFromTuple: t8 receiver: t2].
	#startScene = t3
		ifTrue: [t4 := #showBackground:].
	#nextScene = t3
		ifTrue: [t4 := #nextBackground].
	#% = t3
		ifTrue: [t4 := #\\].
	t5 := BlockSpecDict
				at: t4
				ifAbsent: [].
	t5
		ifNil: [^ t5 := #('undefined' #- #undefined )].
	t6 := BlockColorDict
				at: t4
				ifAbsent: [Color red].
	t7 := self blockFromSpec: t5 color: t6.
	t8 := Array new: 2.
	t8 at: 1 put: t5.
	t8 at: 2 put: t7.
	^ t8! !

!ScriptableScratchMorph methodsFor: 'blocks'!
variableBlockFromTuple: t1 receiver: t2 
	| t3 t4 t5 t6 t7 t8 t9 |
	t3 := t1 at: 2.
	t4 := t2.
	(t2 varNames includes: t3)
		ifFalse: [t5 := t2 ownerOrYourselfThatIsA: ScratchStageMorph.
			t5
				ifNil: [t2 addVariable: t3]
				ifNotNil: [t5 addVariable: t3.
					t4 := t5]].
	t1 first asSymbol = #readVariable
		ifTrue: [^ VariableBlockMorph new commandSpec: t3;
				 receiver: t4].
	t1 first asSymbol = #changeVariable
		ifTrue: [t6 := t1 at: 3.
			t6 = #set:to:
				ifTrue: [t6 := #setVar:to:].
			t7 := SetterBlockMorph new receiver: t4.
			t6 = #setVar:to:
				ifTrue: [t7 initSetterForVar: t3]
				ifFalse: [t7 initChangerForVar: t3].
			t8 := t1 at: 4.
			(t8 isKindOf: Array)
				ifTrue: [(t8 size = 1
							and: [t8 first isKindOf: Array])
						ifTrue: [t8 := t8 first].
					t9 := self blockFromTuple: t8 receiver: t2.
					t7 replaceArgMorph: t7 expressionArg by: t9]
				ifFalse: [t7 expressionArg defaultValue: t8].
			^ t7].
	self error: 'unknown variable spec'! !

!ScriptableScratchMorph methodsFor: 'other ops'!
undefined
	^ self! !

!ScriptableScratchMorph methodsFor: 'accessing'!
readJSON: t1 images: t2 sounds: t3 
	| t4 t5 t7 t8 t9 |
	self
		objName: (t1 at: 'objName').
	media := OrderedCollection new.
	(t1
			at: 'costumes'
			ifAbsent: []) isArray
		ifTrue: [(t1 at: 'costumes')
				do: [:t10 | 
					t7 := 1.0
								/ (t10 at: 'bitmapResolution').
					t5 := (t2
								at: (t10 at: 'baseLayerID')
								ifAbsent: [self defaultImageMedia form])
								magnifyBy: t7.
					t8 := (t10 at: 'rotationCenterX')
								* t7 @ ((t10 at: 'rotationCenterY')
									* t7).
					self addMediaItem: (ImageMedia new form: t5;
							 rotationCenter: t8;
							
							mediaName: (t10 at: 'costumeName'))]].
	self costumeIndex: (t1 at: 'currentCostumeIndex')
			+ 1.
	(t1
			at: 'scripts'
			ifAbsent: []) isArray
		ifTrue: [t4 := OrderedCollection new.
			(t1 at: 'scripts')
				do: [:t10 | 
					t9 := Array new: 3.
					t9 at: 1 put: (t10 at: 1)
							@ (t10 at: 2).
					t9
						at: 2
						put: (t10 at: 3).
					t4 addLast: t9].
			blocksBin := t4 asArray].
	(t1
			at: 'variables'
			ifAbsent: []) isArray
		ifTrue: [(t1 at: 'variables')
				do: [:t10 | self
						addVariable: (t10 at: 'name')
						value: (t10 at: 'value')]].
	(t1
			at: 'lists'
			ifAbsent: []) isArray
		ifTrue: [(t1 at: 'lists')
				do: [:t10 | lists
						at: (t10 at: 'listName')
						put: (ScratchListMorph new
								listName: (t10 at: 'listName')
								target: self;
								
								newContents: (t10 at: 'contents');
								 position: (t10 at: 'x')
									@ (t10 at: 'y');
								 extent: (t10 at: 'width')
									@ (t10 at: 'height'))]]! !


!ScratchSpriteMorph methodsFor: 'accessing'!
readJSON: t1 images: t2 sounds: t3 
	super
		readJSON: t1
		images: t2
		sounds: t3.
	self scalePoint: (t1 at: 'scale')
			@ (t1 at: 'scale');
		
		heading: (t1 at: 'direction');
		
		rotationStyle: (t1 at: 'rotationStyle');
		 position: (t1 at: 'scratchX')
			+ 240 @ (180
				- (t1 at: 'scratchY')) - offsetWhenRotated - costume rotationCenter;
		
		draggable: (t1 at: 'isDraggable');
		
		visible: (t1 at: 'visible')! !


!ScratchStageMorph methodsFor: 'accessing'!
readJSON: t1 images: t2 sounds: t3 
	| t4 t5 t6 t7 t8 |
	super
		readJSON: t1
		images: t2
		sounds: t3.
	t4 := Dictionary new.
	t5 := Dictionary new.
	t6 := OrderedCollection new.
	t7 := OrderedCollection new.
	(t1 at: 'lists') isArray
		ifTrue: [(t1 at: 'lists')
				do: [:t10 | (t10 at: 'visible')
						ifTrue: [t7
								addLast: (lists
										at: (t10 at: 'listName'))]]].
	(t1
			at: 'children'
			ifAbsent: []) isArray
		ifTrue: [(t1 at: 'children')
				do: [:t10 | (t10
						at: 'objName'
						ifAbsent: [])
						ifNil: [(t10
								at: 'sliderMin'
								ifAbsent: [])
								ifNotNil: [(t10 at: 'visible')
										ifTrue: [t6 addLast: t10]]]
						ifNotNil: [t8 := ScratchSpriteMorph new
										readJSON: t10
										images: t2
										sounds: t3.
							self addMorph: t8.
							t4
								at: (t10 at: 'indexInLibrary')
								put: t8.
							t5
								at: (t10 at: 'objName')
								put: t8.
							(t10
									at: 'lists'
									ifAbsent: []) isArray
								ifTrue: [(t10 at: 'lists')
										do: [:t11 | (t11 at: 'visible')
												ifTrue: [t7
														addLast: (t8 lists
																at: (t11 at: 'listName'))]]]]]].
	t4
		do: [:t10 | sprites addLast: t10].
	t5 at: 'Stage' put: self.
	t6
		do: [:t10 | self
				addMorph: (WatcherMorph new readJSON: t10 spritesByName: t5)].
	t7
		do: [:t10 | self addMorph: t10]! !


!WatcherMorph methodsFor: 'accessing'!
readJSON: t1 spritesByName: t2 
	| t3 |
	self
		target: (t2
				at: (t1 at: 'target'))
		selector: (t1 at: 'cmd')
		parameter: (t1 at: 'param');
		
		setCategoryColor: (Color fromString: '#'
					, ((t1 at: 'color')
							printStringRadix: 16)).
	(t1 at: 'mode')
			= 2
		ifTrue: [self layoutStyle: #large].
	(t1 at: 'mode')
			= 3
		ifTrue: [self layoutStyle: #slider].
	t3 := Array new: 2.
	t3
		at: 1
		put: (t1 at: 'sliderMin').
	t3
		at: 2
		put: (t1 at: 'sliderMax').
	self sliderRange: t3;
		 position: (t1 at: 'x')
			@ (t1 at: 'y')! !