'From Squeak6.0alpha of 30 April 2021 [latest update: #20503] on 6 May 2021 at 10:47:18 pm'!

!Flaps class methodsFor: 'miscellaneous' stamp: 'ct 5/6/2021 22:40'!
paintFlapButton
	"Answer a button to serve as the paint flap"

	| pb oldArgs brush myButton m |
	pb := PaintBoxMorph new submorphNamed: #paint:.
	pb
		ifNil:
			[(brush := Form extent: 16@16 depth: 16) fillColor: Color red]
		ifNotNil:
			[oldArgs := pb arguments.
			brush := oldArgs third.
			brush := brush copy: (2@0 extent: 42@38).
			brush := brush scaledBy: 1 / 2].
	myButton := BorderedMorph new.
	myButton color: (Color r: 0.833 g: 0.5 b: 0.0); borderStyle: (BorderStyle raised width: 2).
	myButton addMorph: (m := brush asMorph lock).
	myButton extent: m extent + (myButton borderWidth + 6).
	m position: myButton center - (m extent // 2).
	^ myButton

! !


!HtmlReadWriter methodsFor: 'mapping' stamp: 'ct 5/6/2021 22:41'!
mapImgTag: aTag

	| result startIndex stopIndex attribute src form |
	result := OrderedCollection new.

	"<img src=""https://squeak.org/img/downloads/image.png"">"
	attribute := 'src'.
	startIndex := aTag findString: attribute.
	startIndex > 0 ifTrue: [
		startIndex := aTag findString: '"' startingAt: startIndex+attribute size.
		startIndex > 0
			ifTrue: [stopIndex := aTag findString: '"' startingAt: startIndex+1]
			ifFalse: [
				"URLs without quotes..."
				startIndex := aTag findString: '=' startingAt: startIndex+attribute size.
				stopIndex := aTag findString: '>' startingAt: startIndex+1].
		src := aTag copyFrom: startIndex+1 to: stopIndex-1.
		form := ((self httpGetImage: src) ifNil: [(Form dotOfSize: 12 color: Color veryLightGray)])
			scaledBy: RealEstateAgent scaleFactor.
		result
			add: form asTextAnchor;
			add: (TextColor color: Color transparent)].
	^ result! !


!HtmlReadWriterTest methodsFor: 'tests' stamp: 'ct 5/6/2021 22:41'!
test16ImgTag
	<timeout: 10>

	| imgUrl imgExpression formFromUrl formFromExpression |
	imgUrl := 'https://squeak.org/img/downloads/image.png'.
	imgExpression := 'Form dotOfSize: 12@12 color: Color green'.
	
	self ensureSecureInternetConnection.
	
	formFromUrl := (Smalltalk classNamed: 'WebClient') ifNotNil: [:client |
		Form fromBinaryStream: (client httpGet: imgUrl) content asByteArray readStream].
	formFromExpression := Compiler evaluate: imgExpression.
	
	RealEstateAgent scaleFactor = 1.0 ifFalse: [
		formFromUrl := formFromUrl scaledBy: RealEstateAgent scaleFactor.
		formFromExpression := formFromExpression scaledToSize: (formFromExpression extent * RealEstateAgent scaleFactor)].
	
	{
		'Hello <img src="{1}"> World' format: { imgUrl }.
		('Hello {1} World' format: { Character startOfHeader }) asText
			addAttribute: formFromUrl asTextAnchor from: 7 to: 7;
			addAttribute: (TextColor color: Color transparent) from: 7 to: 7.

		'Hello <img src="code://{1}"> World' format: { imgExpression }.
		('Hello {1} World' format: { Character startOfHeader }) asText
			addAttribute: formFromExpression asTextAnchor from: 7 to: 7;
			addAttribute: (TextColor color: Color transparent) from: 7 to: 7.
		
	} pairsDo: [:expectedHtml :expectedText |
		
		self convertHtml: expectedHtml.
		self assert: expectedText string equals: text string.
		expectedText runs with: text runs do: [:expectedAttributes :actualAttributes |
			expectedAttributes with: actualAttributes do: [:expectedAttribute :actualAttribute |
				self assert: (expectedAttribute = actualAttribute or: [
					((expectedAttribute respondsTo: #anchoredMorph)
						and: [actualAttribute respondsTo: #anchoredMorph])
						and: [(expectedAttribute anchoredMorph "aForm" unhibernate; bits)
							= (actualAttribute anchoredMorph "aForm" unhibernate; bits)]  ]) ]]].! !


!PlaybackInvoker methodsFor: 'initialization' stamp: 'ct 5/6/2021 22:41'!
initializeFrom: anEventRecordingSpace
	"Initialize the receiver from the given recording space."

	| beforeImage theatreCopy |

	theatreCopy := anEventRecordingSpace veryDeepCopy.
	"Still want to do the below but there are still maddening problems with it."
	"theatreCopy convertToCanonicalForm."

	autoStart := true.
	autoDismiss := true.

	caption := theatreCopy captionString.
	offeringHint := true.

	beforeImage := theatreCopy initialPicture.

	beforeBitmap := beforeImage scaledBy: 0.3.

	theatreCopy rewind.
	contentArea := theatreCopy initialContentArea veryDeepCopy.
	tape := theatreCopy eventRecorder tape veryDeepCopy.
	caption := theatreCopy captionString.

	theatreCopy balloonHelpString ifNotNil:
		[:t | self setBalloonText: t].

	self form: beforeBitmap.

	initialPicture := anEventRecordingSpace initialPicture veryDeepCopy.
	finalPicture := anEventRecordingSpace finalPicture veryDeepCopy.

	postPlaybackImageFeature := false.

	self on: #mouseUp send: #launchPlayback to: self


	! !

!PlaybackInvoker methodsFor: 'appearance' stamp: 'ct 5/6/2021 22:42'!
installScaledFinalPictureAsIcon
	"Like de selector say."

	self adoptAsCurrentForm: (finalPicture scaledBy: 0.5)! !


!ProjectNavigationMorph methodsFor: 'the buttons' stamp: 'ct 5/6/2021 22:41'!
buttonPaint

	| pb oldArgs brush myButton m |

	myButton := self makeButton: '' balloonText: 'Make a painting' translated for: #doNewPainting.
	pb := PaintBoxMorph new submorphNamed: #paint:.
	pb ifNil: [
		(brush := Form extent: 16@16 depth: 16) fillColor: Color red
	] ifNotNil: [
		oldArgs := pb arguments.
		brush := oldArgs third.
		brush := brush copy: (2@0 extent: 42@38).
		brush := brush scaledBy: 1 / 2.
	].
	myButton addMorph: (m := brush asMorph lock).
	myButton extent: m extent + (myButton borderWidth + 6).
	m position: myButton center - (m extent // 2).

	^myButton

"brush := (ScriptingSystem formAtKey: 'Painting')."

! !

