'From Squeak3.1alpha of 7 February 2001 [latest update: #3656] on 19 February 2001 at 12:17:11 pm'! "Change Set: noticePaintFlap-sw Date: 19 February 2001 Author: Scott Wallace Makes the automatic placement of viewer flap tabs be cognizant of the presence of a painting flap tab"! !PasteUpMorph methodsFor: 'misc' stamp: 'sw 2/19/2001 12:14'! viewerFlapTabFor: anObject "Open up a Viewer on aMorph in its own flap, creating it if necessary" | bottomMost aPlayer aFlapTab | bottomMost _ self top. aPlayer _ anObject isMorph ifTrue: [anObject assuredPlayer] ifFalse: [anObject objectRepresented]. self flapTabs do: [:aTab | ((aTab isKindOf: ViewerFlapTab) or: [aTab hasProperty: #paintingFlap]) ifTrue: [bottomMost _ aTab bottom max: bottomMost. ((aTab isKindOf: ViewerFlapTab) and: [aTab scriptedPlayer == aPlayer]) ifTrue: [^ aTab]]]. "Not found; make a new one" aFlapTab _ (Utilities newFlapTitled: anObject nameForViewer onEdge: #right inPasteUp: self) as: ViewerFlapTab. aFlapTab initializeFor: aPlayer topAt: bottomMost + 2. aFlapTab referent color: (Color green muchLighter alpha: 0.5). aFlapTab referent borderWidth: 0. aFlapTab referent setProperty: #automaticPhraseExpansion toValue: true. Preferences compactViewerFlaps ifTrue:[aFlapTab makeFlapCompact: true]. self addMorphFront: aFlapTab. aFlapTab adaptToWorld: self. ^ aFlapTab! ! !PasteUpMorph methodsFor: 'misc' stamp: 'sw 2/19/2001 12:15'! viewerFlapTabForObject: anObject "Open up a Viewer on anObject in its own flap, creating it if necessary. This is the viewer-for-any-object version of this method, but in the current corpus of code is not hooked up." | bottomMost aFlapTab | bottomMost _ 0. self flapTabs do: [:aTab | ((aTab isKindOf: ViewerFlapTab) or: [aTab hasProperty: #paintingFlap]) ifTrue: [bottomMost _ aTab bottom max: bottomMost. ((aTab isKindOf: ViewerFlapTab) and: [aTab scriptedPlayer == anObject]) ifTrue: [^ aTab]]]. "Not found; make a new one" aFlapTab _ (Utilities newFlapTitled: anObject externalName onEdge: #right) as: ViewerFlapTab. aFlapTab initializeFor: anObject topAt: bottomMost + 2. aFlapTab referent color: (Color green muchLighter alpha: 0.5). aFlapTab referent setProperty: #automaticPhraseExpansion toValue: true. self addMorphFront: aFlapTab. aFlapTab adaptToWorld: self. ^ aFlapTab! ! !Utilities class methodsFor: 'flaps' stamp: 'sw 2/19/2001 12:08'! addPaintingFlap "Add a flap with the paint palette in it" | aFlap aFlapTab | "Utilities reinstateDefaultFlaps. Utilities addPaintingFlap" aFlap _ PasteUpMorph new borderWidth: 0. aFlap color: Color transparent. aFlap layoutPolicy: TableLayout new. aFlap hResizing: #shrinkWrap. aFlap vResizing: #shrinkWrap. aFlap cellPositioning: #topLeft. aFlap clipSubmorphs: false. aFlap beSticky. "really?!!" aFlap addMorphFront: PaintBoxMorph new. aFlap setProperty: #flap toValue: true. aFlap fullBounds. "force layout" aFlapTab _ FlapTab new referent: aFlap. aFlapTab useGraphicalTab. aFlapTab removeAllMorphs. aFlapTab setProperty: #paintingFlap toValue: true. aFlapTab addMorphFront: "(SketchMorph withForm: (ScriptingSystem formAtKey: #PaintingFlapPic))" self paintFlapButton. aFlapTab cornerStyle: #rounded. aFlapTab edgeToAdhereTo: #right. aFlapTab setToPopOutOnDragOver: false. aFlapTab setToPopOutOnMouseOver: false. aFlapTab on: #mouseUp send: #startOrFinishDrawing: to: aFlapTab. aFlapTab setBalloonText:'Click here to start or finish painting.'. aFlapTab fullBounds. "force layout" aFlapTab position: (0@6). self currentWorld addMorphFront: aFlapTab. "a local flap, but we could as easily make it global by: self addGlobalFlap: aFlapTab. self currentWorld addGlobalFlaps"! !