'From Squeak3.1alpha of 4 February 2001 [latest update: #3647] on 21 March 2001 at 11:53:26 am'! !FlapTab methodsFor: 'menu' stamp: 'ar 2/8/2001 19:28'! wantsRoundedCorners ^self isCurrentlyTextual or:[self cornerStyle == #rounded]! ! !FlapTab methodsFor: 'mouseover & dragover' stamp: 'ar 12/18/2000 01:14'! makeNewDrawing: evt self flapShowing ifTrue:[ self world makeNewDrawing: evt. ] ifFalse:[ self world assureNotPaintingEvent: evt. ].! ! !FlapTab methodsFor: 'mouseover & dragover' stamp: 'ar 2/8/2001 19:27'! startOrFinishDrawing: evt | w | self flapShowing ifTrue:[ (w _ self world) makeNewDrawing: evt at: w center. ] ifFalse:[ self world endDrawing: evt. ].! ! !PaintBoxMorph methodsFor: 'actions' stamp: 'ar 12/19/2000 19:16'! showColorPalette: evt | w box | self comeToFront. colorMemory align: colorMemory bounds topRight with: colorMemoryThin bounds topRight. "make sure color memory fits or else align with left" w _ self world. box _ self bounds: colorMemory fullBounds in: w. box left < 0 ifTrue:[ colorMemory align: colorMemory bounds topLeft with: colorMemoryThin bounds topLeft]. self addMorphFront: colorMemory.! ! !PasteUpMorph methodsFor: 'misc' stamp: 'ar 2/12/2001 23:17'! hideViewerFlaps self flapTabs do:[:aTab | (aTab isKindOf: ViewerFlapTab) ifTrue:[aTab hideFlap]]! ! !PasteUpMorph methodsFor: 'world state' stamp: 'ar 12/18/2000 01:16'! assureNotPaintingEvent: evt "If painting is already underway in the receiver, put up an informer to that effect and evalute aBlock" | editor | (editor _ self sketchEditorOrNil) ifNotNil:[ editor save: evt. Cursor normal show. ].! ! !PasteUpMorph methodsFor: 'world state' stamp: 'ar 12/19/2000 19:23'! endDrawing: evt "If painting is already underway in the receiver, finish and save it." | editor | (editor _ self sketchEditorOrNil) ifNotNil:[ editor save: evt. Cursor normal show. ].! ! !PasteUpMorph methodsFor: 'world menu' stamp: 'ar 2/8/2001 19:26'! makeNewDrawing: evt ^self makeNewDrawing: evt at: evt position! ! !PasteUpMorph methodsFor: 'world menu' stamp: 'ar 2/8/2001 19:27'! makeNewDrawing: evt at: aPoint | w newSketch newPlayer sketchEditor aPaintBox aPalette tfx whereToPresent rect ownerBeforeHack aPaintTab aWorld | w _ self world. w assureNotPaintingElse: [^ self]. rect _ self paintingBoundsAround: aPoint. aPalette _ self standardPalette. aPalette ifNotNil: [aPalette showNoPalette; layoutChanged]. w stopRunningAll; abandonAllHalos. newSketch _ self drawingClass new player: (newPlayer _ UnscriptedPlayer newUserInstance). newPlayer costume: newSketch. newSketch form: (Form extent: rect extent depth: w assuredCanvas depth). newSketch bounds: rect. sketchEditor _ SketchEditorMorph new. w addMorphFront: sketchEditor. sketchEditor initializeFor: newSketch inBounds: rect pasteUpMorph: self. sketchEditor afterNewPicDo: [:aForm :aRect | whereToPresent _ self presenter. newSketch form: aForm. tfx _ self transformFrom: w. newSketch position: (tfx globalPointToLocal: aRect origin). newSketch rotationStyle: sketchEditor rotationStyle. newSketch forwardDirection: sketchEditor forwardDirection. ownerBeforeHack _ newSketch owner. "about to break the invariant!!!!" newSketch privateOwner: self. "temp for halo access" newPlayer setHeading: sketchEditor forwardDirection. (aPaintTab _ (aWorld _ self world) paintingFlapTab) ifNotNil:[aPaintTab hideFlap] ifNil:[(aPaintBox _ aWorld paintBox) ifNotNil:[aPaintBox delete]]. "Includes newSketch rotationDegrees: sketchEditor forwardDirection." newSketch privateOwner: ownerBeforeHack. "probably nil, but let's be certain" self addMorphFront: newPlayer costume. w startSteppingSubmorphsOf: newSketch. whereToPresent drawingJustCompleted: newSketch] ifNoBits:[ (aPaintTab _ (aWorld _ self world) paintingFlapTab) ifNotNil:[aPaintTab hideFlap] ifNil:[(aPaintBox _ aWorld paintBox) ifNotNil:[aPaintBox delete]]. aPalette ifNotNil: [aPalette showNoPalette].]! ! !Presenter methodsFor: 'misc' stamp: 'ar 12/18/2000 16:13'! drawingJustCompleted: aSketchMorph | aWorld | aWorld _ associatedMorph world. (aWorld hasProperty: #automaticFlapViewing) ifTrue: [^ aWorld presenter viewMorph: aSketchMorph]. (aSketchMorph pasteUpMorph hasProperty: #automaticViewing) ifTrue: [self viewMorph: aSketchMorph]! ! !SketchEditorMorph methodsFor: 'initialization' stamp: 'ar 2/12/2001 23:18'! initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph | aPaintBox newPaintBoxBounds worldBounds requiredWidth newOrigin aPosition aPal aTab paintBoxFullBounds | (aTab _ self world paintingFlapTab) ifNotNil: [aTab showFlap. aPasteUpMorph hideViewerFlaps. ^ self initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosition: nil]. aPaintBox _ self world paintBox. worldBounds _ self world bounds. requiredWidth _ aPaintBox width. aPosition _ (aPal _ aPasteUpMorph standardPalette) ifNotNil: [aPal showNoPalette. aPal topRight + (aPaintBox width negated @ 0 "aPal tabsMorph height")] ifNil: [boundsToUse topRight]. newOrigin _ ((aPosition x + requiredWidth <= worldBounds right) or: [Preferences unlimitedPaintArea]) ifTrue: "will fit to right of aPasteUpMorph" [aPosition] ifFalse: "won't fit to right, try left" [boundsToUse topLeft - (requiredWidth @ 0)]. paintBoxFullBounds _ aPaintBox maxBounds. paintBoxFullBounds _ (newOrigin - aPaintBox offsetFromMaxBounds) extent: paintBoxFullBounds extent. newPaintBoxBounds _ paintBoxFullBounds translatedToBeWithin: worldBounds. self initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosition: newPaintBoxBounds origin + aPaintBox offsetFromMaxBounds.! ! !SketchMorph methodsFor: 'menu' stamp: 'ar 12/19/2000 19:27'! editDrawingIn: aPasteUpMorph forBackground: forBackground | w bnds sketchEditor pal aPaintTab aWorld aPaintBox tfx | self world assureNotPaintingElse: [^ self]. w _ aPasteUpMorph world. w stopRunningAll; abandonAllHalos. w displayWorld. self visible: false. forBackground ifTrue: [bnds _ aPasteUpMorph boundsInWorld] ifFalse: [bnds _ (self boundsInWorld expandBy: (60 @ 60)) intersect: self world bounds. bnds _ (aPasteUpMorph paintingBoundsAround: bnds center) merge: bnds]. sketchEditor _ SketchEditorMorph new. forBackground ifTrue: [sketchEditor setProperty: #background toValue: true]. w addMorphFront: sketchEditor. sketchEditor initializeFor: self inBounds: bnds pasteUpMorph: aPasteUpMorph. sketchEditor afterNewPicDo: [:aForm :aRect | self visible: true. self form: aForm. tfx _ aPasteUpMorph transformFrom: aPasteUpMorph world. self topRendererOrSelf position: (tfx globalPointToLocal: aRect origin). self rotationStyle: sketchEditor rotationStyle. self forwardDirection: sketchEditor forwardDirection. (aPaintTab _ (aWorld _ self world) paintingFlapTab) ifNotNil:[aPaintTab hideFlap] ifNil:[(aPaintBox _ aWorld paintBox) ifNotNil:[aPaintBox delete]]. self presenter drawingJustCompleted: self. forBackground ifTrue: [self goBehind]] "shouldn't be necessary" ifNoBits: ["If no bits drawn. Must keep old pic. Can't have no picture" self visible: true. aWorld _ self currentWorld. "sometimes by now I'm no longer in a world myself, but we still need to get ahold of the world so that we can deal with the palette" ((pal _ aPasteUpMorph standardPalette) notNil and: [pal isInWorld]) ifTrue: [(aPaintBox _ aWorld paintBox) ifNotNil: [aPaintBox delete]. pal viewMorph: self] ifFalse:[ (aPaintTab _ (aWorld _ self world) paintingFlapTab) ifNotNil:[aPaintTab hideFlap] ifNil:[(aPaintBox _ aWorld paintBox) ifNotNil:[aPaintBox delete]]]]! ! !TheWorldMenu methodsFor: 'windows & flaps menu' stamp: 'ar 2/8/2001 19:19'! windowsMenu "Build the windows menu for the world." ^ self fillIn: (self menu: 'windows & flaps...') from: { { 'find window' . { #myWorld . #findWindow: }. 'Presents a list of all windows; if you choose one from the list, it becomes the active window.'}. { 'find changed browsers...' . { #myWorld . #findDirtyBrowsers: }. 'Presents a list of browsers that have unsubmitted changes; if you choose one from the list, it becomes the active window.'}. { 'find changed windows...' . { #myWorld . #findDirtyWindows: }. 'Presents a list of all windows that have unsubmitted changes; if you choose one from the list, it becomes the active window.'}. nil. { 'find a transcript (t)' . { #myWorld . #findATranscript: }. 'Brings an open Transcript to the front, creating one if necessary, and makes it the active window'}. { 'find a change sorter (C)' . { #myWorld . #findAChangeSorter: }. 'Brings an open change sorter to the front, creating one if necessary, and makes it the active window'}. nil. { #staggerPolicyString . { self . #toggleWindowPolicy }. 'stagger: new windows positioned so you can see a portion of each one. tile: new windows positioned so that they do not overlap others, if possible.'}. nil. { 'collapse all windows' . { #myWorld . #collapseAll }. 'Reduce all open windows to collapsed forms that only show titles.'}. { 'expand all windows' . { #myWorld . #expandAll }. 'Expand all collapsed windows back to their expanded forms.'}. { 'close top window (w)' . { SystemWindow . #closeTopWindow }. 'Close the topmost window if possible.'}. { 'send top window to back (\)' . { SystemWindow . #sendTopWindowToBack }. 'Make the topmost window become the backmost one, and activate the window just beneath it.'}. { 'move windows onscreen' . { #myWorld . #bringWindowsFullOnscreen }. 'Make all windows fully visible on the screen'}. nil. { 'delete unchanged windows' . { #myWorld . #closeUnchangedWindows }. 'Deletes all windows that do not have unsaved text edits.'}. { 'delete non-windows' . { #myWorld . #deleteNonWindows }. 'Deletes all non-window morphs lying on the world.'}. { 'delete both of the above' . { self . #cleanUpWorld }. 'deletes all unchanged windows and also all non-window morphs lying on the world, other than flaps.'}. nil. " { #suppressFlapsString . { self . #toggleFlapSuppressionInProject }. 'Governs whether flaps should be shown in this project'}." { #useGlobalFlapsString . { self. #toggleWhetherToUseGlobalFlaps }. 'Governs whether a universal set of "global" flaps should be sharable by all morphic projects.'}. { #whichGlobalFlapsString . { Utilities. #offerGlobalFlapsMenu }. 'Put up a menu that allows you to choose which global flaps to show in this project'. #globalFlapsEnabled}. { #newGlobalFlapString . { Utilities . #addGlobalFlap }. 'Create a new flap that will be shared by all morphic projects'. #globalFlapsEnabled}. nil. { 'new project flap...' . { Utilities . #addLocalFlap }. 'Create a new flap to be used only in this project.'}. { 'add stack-tools flap' . { Utilities . #addStackToolsFlap }. 'Add a flap in this project that offers tools for creating stacks and cards.'}. { 'add painting flap' . { Utilities . #addPaintingFlap }. 'Add a painting flap for this project.'}. { 'add menu flap' . { Utilities . #addMenuFlap }. 'Add a flap in this project that shows most of the standard world menus all at once.'}. nil. { 'about flaps...' . { Utilities . #explainFlaps }. 'Gives a window full of details about how to use flaps.'}. }! ! !Utilities class methodsFor: 'flaps' stamp: 'ar 3/21/2001 11:51'! 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 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"! ! !Utilities class methodsFor: 'flaps' stamp: 'ar 2/8/2001 19:36'! paintFlapButton | 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 scaledToSize: brush extent // 2. ]. myButton _ BorderedMorph new. myButton color: (Color r: 0.833 g: 0.5 b: 0.0); borderWidth: 2; borderColor: #raised. myButton addMorph: (m _ brush asMorph lock). myButton extent: m extent + (myButton borderWidth + 6). m position: myButton center - (m extent // 2). ^myButton ! !