[squeak-dev] The Trunk: MorphicWiW-ar.1.mczcommits at source.squeak.org commits at source.squeak.orgSun Sep 20 03:34:58 UTC 2009
Andreas Raab uploaded a new version of MorphicWiW to project The Trunk: http://source.squeak.org/trunk/MorphicWiW-ar.1.mcz ==================== Summary ==================== Name: MorphicWiW-ar.1 Author: ar Time: 19 September 2009, 8:34:42 am UUID: 2db8be34-2f7e-a34b-ace4-f200f619b5f3 Ancestors: Package containing the (retired) Morphic World-in-World facilities. ==================== Snapshot ==================== SystemOrganization addCategory: #'MorphicWiW-ST80'! SystemOrganization addCategory: #'MorphicWiW-Basic'! SystemWindow subclass: #NewWorldWindow instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'MorphicWiW-Basic'! ----- Method: NewWorldWindow>>addMorph:frame: (in category 'panes') ----- addMorph: aMorph frame: relFrame | cc | cc := aMorph color. super addMorph: aMorph frame: relFrame. aMorph color: cc.! ----- Method: NewWorldWindow>>amendSteppingStatus (in category 'stepping') ----- amendSteppingStatus! ----- Method: NewWorldWindow>>openInWorld: (in category 'initialization') ----- openInWorld: aWorld | xxx | "This msg and its callees result in the window being activeOnlyOnTop" xxx := RealEstateAgent initialFrameFor: self world: aWorld. "Bob say: 'opening in ',xxx printString,' out of ',aWorld bounds printString. 6 timesRepeat: [Display flash: xxx andWait: 300]." self bounds: xxx. ^self openAsIsIn: aWorld.! ----- Method: NewWorldWindow>>setStripeColorsFrom: (in category 'label') ----- setStripeColorsFrom: paneColor "Since our world may be *any* color, try to avoid really dark colors so title will show" | revisedColor | stripes ifNil: [^ self]. revisedColor := paneColor atLeastAsLuminentAs: 0.1 . self isActive ifTrue: [stripes second color: revisedColor; borderColor: stripes second color darker. stripes first color: stripes second borderColor darker; borderColor: stripes first color darker. ^ self]. "This could be much faster" stripes second color: revisedColor; borderColor: revisedColor. stripes first color: revisedColor; borderColor: revisedColor! ----- Method: NewWorldWindow>>setWindowColor: (in category 'color') ----- setWindowColor: incomingColor | existingColor aColor | incomingColor ifNil: [^ self]. "it happens" aColor := incomingColor asNontranslucentColor. (aColor = ColorPickerMorph perniciousBorderColor or: [aColor = Color black]) ifTrue: [^ self]. existingColor := self paneColorToUse. existingColor ifNil: [^ Beeper beep]. self setStripeColorsFrom: aColor ! ----- Method: NewWorldWindow>>updatePaneColors (in category 'panes') ----- updatePaneColors "Useful when changing from monochrome to color display" self setStripeColorsFrom: self paneColorToUse. "paneMorphs do: [:p | p color: self paneColorToUse]." "since pane is a world, skip this" ! ----- Method: NewWorldWindow>>wantsSteps (in category 'testing') ----- wantsSteps ^true! SystemWindow subclass: #WorldWindow instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'MorphicWiW-Basic'! !WorldWindow commentStamp: '<historical>' prior: 0! A WorldWindow is a SystemWindow whose central area presents an inner Morphic world. WorldWindows have a red title bar when the world inside is inactive. This changes to green when the world becomes the active world. The world inside becomes activated by clicking in it. When you click outside this world, the parent world resumes control. While its world is inactive, the WorldWindow may be moved and resized like any other. It would be nice to make the world inside active whenever the WorldWindow was active, but this presents difficulties in moving and resizing, probably related to use of the global World instead of self world in many methods. This facility is mainly the work of Bob Arning, with a number of tweaks by DI. ! ----- Method: WorldWindow class>>test1 (in category 'as yet unclassified') ----- test1 "WorldWindow test1." | window world | world := WiWPasteUpMorph newWorldForProject: nil. window := (WorldWindow labelled: 'Inner World') model: world. window addMorph: world. world hostWindow: window. window openInWorld ! ----- Method: WorldWindow class>>test2 (in category 'as yet unclassified') ----- test2 "WorldWindow test2." | window world scrollPane | world := WiWPasteUpMorph newWorldForProject: nil. window := (WorldWindow labelled: 'Scrollable World') model: world. window addMorph: (scrollPane := TwoWayScrollPane new model: world) frame: (0 at 0 extent: 1.0 at 1.0). scrollPane scroller addMorph: world. world hostWindow: window. window openInWorld ! ----- Method: WorldWindow>>buildWindowMenu (in category 'menu') ----- buildWindowMenu | aMenu | aMenu := super buildWindowMenu. {640 at 480. 800 at 600. 832 at 624. 1024 at 768} do: [ :each | aMenu add: each x printString,' x ',each y printString target: self selector: #extent: argument: each + (0 at self labelHeight). ]. ^aMenu! ----- Method: WorldWindow>>collapseOrExpand (in category 'resize/collapse') ----- collapseOrExpand super collapseOrExpand. isCollapsed ifFalse: [model becomeTheActiveWorldWith: nil]! ----- Method: WorldWindow>>extent: (in category 'geometry') ----- extent: x super extent: x. model ifNil: [^self]. model extent: self panelRect extent.! ----- Method: WorldWindow>>fullBounds (in category 'layout') ----- fullBounds ^self bounds! ----- Method: WorldWindow>>mouseUp: (in category 'event handling') ----- mouseUp: evt (self panelRect containsPoint: evt cursorPoint) ifTrue: [model becomeTheActiveWorldWith: evt]! ----- Method: WorldWindow>>openInWorld: (in category 'initialization') ----- openInWorld: aWorld "This msg and its callees result in the window being activeOnlyOnTop" self bounds: (RealEstateAgent initialFrameFor: self world: aWorld). self firstSubmorph position: (self left + 1) @ (self top + self labelHeight). ^self openAsIsIn: aWorld! Controller subclass: #MorphWorldController instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'MorphicWiW-ST80'! !MorphWorldController commentStamp: '<historical>' prior: 0! I am a controller for SceneViews. I support gestures for scrolling, click-selection, and area selection of scene glyphs. (See the class comment in GestureController for more details about gestures.) I also support construction operations such as inserting new glyphs and merging glyphs to make them share a common point. The mapping of gestures to actions is as follows (see GestureController comment for more about gestures): Click: click on glyph select glyph shift-click on glyph toggle selection of that glyph click on background clear selection Double click: double-click on glyph inspect glyph double-click on background select all Hold/Drag/Sweep: hold (no movement) yellow-button menu drag (up/left movement) scrolling hand sweep (down/right movement) select glyphs in region shift-sweep toggle selection of glyphs in region ! ----- Method: MorphWorldController>>controlActivity (in category 'control defaults') ----- controlActivity "Do one step of the Morphic interaction loop. Called repeatedly while window is active." model doOneCycle. ! ----- Method: MorphWorldController>>controlInitialize (in category 'basic control sequence') ----- controlInitialize "This window is becoming active." true ifTrue: [model becomeTheActiveWorldWith: nil]. model canvas ifNil: [ "i.e., only on first entry" "In case of, eg, inspect during balloon help..." model submorphsDo: [:m | "delete any existing balloons" (m isKindOf: BalloonMorph) ifTrue: [m delete]]. model handsDo: [:h | h initForEvents]. view displayView]. "initializes the WorldMorph's canvas" ! ----- Method: MorphWorldController>>controlLoop (in category 'basic control sequence') ----- controlLoop "Overridden to keep control active when the hand goes out of the view" | db | [self viewHasCursor "working in the window" or: [Sensor noButtonPressed "wandering with no button pressed" or: [model primaryHand submorphs size > 0 "dragging something outside"]]] whileTrue: "... in other words anything but clicking outside" [self controlActivity. "Check for reframing since we hold control here" db := view superView displayBox. view superView controller checkForReframe. db = view superView displayBox ifFalse: [self controlInitialize "reframe world if bounds changed"]]. ! ----- Method: MorphWorldController>>controlTerminate (in category 'basic control sequence') ----- controlTerminate "This window is becoming inactive; restore the normal cursor." Cursor normal show. ActiveWorld := ActiveHand := ActiveEvent := nil! ----- Method: MorphWorldController>>isControlActive (in category 'control defaults') ----- isControlActive ^ sensor redButtonPressed or: [self viewHasCursor]! View subclass: #MorphWorldView instanceVariableNames: '' classVariableNames: 'FullColorWhenInactive' poolDictionaries: '' category: 'MorphicWiW-ST80'! !MorphWorldView commentStamp: '<historical>' prior: 0! I am a view used to display a Scene. I may be scrolled by adjusting my offset. My default controller is SceneController. SceneViews encapsulate the notion of a changing foreground and a fixed background during interactive updates. During an interaction (such as dragging), some of the glyphs will not change location or appearance. These are part of the "background". All glyphs that may change (the "foreground" glyphs) are painted against this unchanging backdrop during the interaction. Instance Variables: offset the current offset of this view (used for scrolling) enclosingRect a rectangle large enough to contain all the objects in the scene, plus a small border (this is a cache that must be recomputed when glyphs are moved, added, or removed from the scene) backgroundForm a <Form> containing the fixed background visibleForeground the glyphs that are changing but not selected during an interaction selectedForeground the selected glyphs that are changing during an interaction! ----- Method: MorphWorldView class>>fullColorWhenInactive (in category 'instance creation') ----- fullColorWhenInactive FullColorWhenInactive ifNil: [FullColorWhenInactive := true]. ^ FullColorWhenInactive ! ----- Method: MorphWorldView class>>fullColorWhenInactive: (in category 'instance creation') ----- fullColorWhenInactive: fullColor "MorphWorldView fullColorWhenInactive: true" "If FullColorWhenInactive is true then WorldMorphViews will created inside StandardSystemViews that cache their contents in full-color when the window is inactive. If it is false, only a half-tone gray approximation of the colors will be cached to save space." FullColorWhenInactive := fullColor. "Retroactively convert all extant windows" ((fullColor ifTrue: [StandardSystemView] ifFalse: [ColorSystemView]) allInstances select: [:v | v subViews notNil and: [v subViews isEmpty not and: [v firstSubView isKindOf: MorphWorldView]]]) do: [:v | v uncacheBits. v controller toggleTwoTone]! ----- Method: MorphWorldView class>>openOn: (in category 'instance creation') ----- openOn: aMorphWorld "Open a view on the given WorldMorph." self openOn: aMorphWorld label: 'A Morphic World'.! ----- Method: MorphWorldView class>>openOn:label: (in category 'instance creation') ----- openOn: aWorldMorph label: aString "Open a view with the given label on the given WorldMorph." ^ self openOn: aWorldMorph label: aString model: (CautiousModel new initialExtent: aWorldMorph initialExtent)! ----- Method: MorphWorldView class>>openOn:label:cautionOnClose: (in category 'instance creation') ----- openOn: aWorldMorph label: aString cautionOnClose: aBoolean "Open a view with the given label on the given WorldMorph." | aModel | aModel := aBoolean ifTrue: [CautiousModel new] ifFalse: [WorldViewModel new]. ^ self openOn: aWorldMorph label: aString model: (aModel initialExtent: aWorldMorph initialExtent)! ----- Method: MorphWorldView class>>openOn:label:extent: (in category 'instance creation') ----- openOn: aWorldMorph label: aString extent: aPoint "Open a view with the given label and extent on the given WorldMorph." ^ self openOn: aWorldMorph label: aString model: (CautiousModel new initialExtent: aPoint) ! ----- Method: MorphWorldView class>>openOn:label:model: (in category 'instance creation') ----- openOn: aWorldMorph label: aString model: aModel "Open a view with the given label on the given WorldMorph." | topView | topView := self fullColorWhenInactive ifTrue: [topView := ColorSystemView new] ifFalse: [topView := StandardSystemView new]. topView model: aModel; label: aString; borderWidth: 1; addSubView: (self new model: aWorldMorph); backgroundColor: aWorldMorph color. "minimumSize: aWorldMorph extent + (2 at 2); " "add border width" topView controller open! ----- Method: MorphWorldView class>>openWorld (in category 'instance creation') ----- openWorld | w | (w := MVCWiWPasteUpMorph newWorldForProject: nil). w bounds: (0 at 0 extent: 400 at 300). self openOn: w label: 'A Morphic World' extent: w fullBounds extent + 2. ! ----- Method: MorphWorldView class>>openWorldWith:labelled: (in category 'instance creation') ----- openWorldWith: aMorph labelled: labelString | w | (w := MVCWiWPasteUpMorph newWorldForProject: nil) addMorph: aMorph. w extent: aMorph fullBounds extent. w startSteppingSubmorphsOf: aMorph. self openOn: w label: labelString extent: w fullBounds extent + 2. ! ----- Method: MorphWorldView>>computeInsetDisplayBox (in category 'private') ----- computeInsetDisplayBox "This overrides the same method in View. (It avoids using displayTransform: because it can return inaccurate results, causing a MorphWorldView's inset display box to creep inward when resized.)" ^superView insetDisplayBox insetBy: borderWidth! ----- Method: MorphWorldView>>deEmphasizeView (in category 'deEmphasizing') ----- deEmphasizeView "This window is becoming inactive." Cursor normal show. "restore the normal cursor" model deEmphasizeViewMVC: self topView cacheBitsAsTwoTone. ! ----- Method: MorphWorldView>>defaultControllerClass (in category 'controller access') ----- defaultControllerClass ^ MorphWorldController! ----- Method: MorphWorldView>>displayView (in category 'displaying') ----- displayView "This method is called by the system when the top view is framed or moved." | topView | model viewBox: self insetDisplayBox. self updateSubWindowExtent. topView := self topView. (topView == ScheduledControllers scheduledControllers first view or: [topView cacheBitsAsTwoTone not]) ifTrue: [model displayWorldSafely] ifFalse: [model displayWorldAsTwoTone]. "just restoring the screen"! ----- Method: MorphWorldView>>update: (in category 'updating') ----- update: symbol ^ symbol == #newColor ifTrue: [self topView backgroundColor: model color dominantColor; uncacheBits; display] ifFalse: [super update: symbol]. ! ----- Method: MorphWorldView>>updateSubWindowExtent (in category 'as yet unclassified') ----- updateSubWindowExtent "If this MorphWorldView represents a single Morphic SystemWindow, then update that window to match the size of the WorldView." | numMorphs subWindow | numMorphs := model submorphs size. "(Allow for the existence of an extra NewHandleMorph (for resizing).)" (numMorphs = 0 or: [numMorphs > 2]) ifTrue: [^self]. subWindow := model submorphs detect: [:ea | ea respondsTo: #label] ifNone: [^self]. superView label = subWindow label ifFalse: [^self]. subWindow position: model position + (0 @ -16). "adjust for WiW changes" subWindow extent: model extent - (0 @ -16). subWindow isActive ifFalse: [subWindow activate]! PasteUpMorph subclass: #WiWPasteUpMorph instanceVariableNames: 'parentWorld hostWindow pendingEvent displayChangeSignatureOnEntry' classVariableNames: 'Debug' poolDictionaries: '' category: 'MorphicWiW-Basic'! !WiWPasteUpMorph commentStamp: '<historical>' prior: 0! This subclass of PasteUpMorph provides special support for viewing of a world in an inner window (WorldWindow).! WiWPasteUpMorph subclass: #MVCWiWPasteUpMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'MorphicWiW-ST80'! !MVCWiWPasteUpMorph commentStamp: '<historical>' prior: 0! A subclass of WiWPasteUpMorph that supports Morphic worlds embedded in MVC Views.! ----- Method: MVCWiWPasteUpMorph>>becomeTheActiveWorldWith: (in category 'activation') ----- becomeTheActiveWorldWith: evt worldState canvas: nil. "safer to start from scratch" self installFlaps. ! ----- Method: MVCWiWPasteUpMorph>>invalidRect:from: (in category 'change reporting') ----- invalidRect: damageRect from: aMorph worldState ifNil: [^self]. worldState recordDamagedRect: damageRect ! ----- Method: MVCWiWPasteUpMorph>>isWindowForModel: (in category 'testing') ----- isWindowForModel: aModel "Return true if the receiver acts as the window for the given model" ^aModel == self model! ----- Method: MVCWiWPasteUpMorph>>position: (in category 'geometry') ----- position: aPoint "Change the position of this morph and and all of its submorphs." | delta | delta := aPoint - bounds topLeft. (delta x = 0 and: [delta y = 0]) ifTrue: [^ self]. "Null change" self changed. self privateFullMoveBy: delta. self changed. ! ----- Method: MVCWiWPasteUpMorph>>project (in category 'project') ----- project ^ Project current! ----- Method: MVCWiWPasteUpMorph>>resetViewBox (in category 'geometry') ----- resetViewBox | c | (c := worldState canvas) isNil ifTrue: [^self resetViewBoxForReal]. c form == Display ifFalse: [^self resetViewBoxForReal]. c origin = (0 @ 0) ifFalse: [^self resetViewBoxForReal]. c clipRect extent = self viewBox extent ifFalse: [^self resetViewBoxForReal]! ----- Method: MVCWiWPasteUpMorph>>resetViewBoxForReal (in category 'geometry') ----- resetViewBoxForReal self viewBox ifNil: [^self]. worldState canvas: ( (Display getCanvas) copyOffset: 0 at 0 clipRect: self viewBox )! ----- Method: MVCWiWPasteUpMorph>>revertToParentWorldWithEvent: (in category 'activation') ----- revertToParentWorldWithEvent: evt ">>unused, but we may want some of this later self damageRecorder reset. World := parentWorld. World assuredCanvas. World installFlaps. owner changed. hostWindow setStripeColorsFrom: Color red. World restartWorldCycleWithEvent: evt. <<<" ! ----- Method: MVCWiWPasteUpMorph>>viewBox: (in category 'project state') ----- viewBox: newViewBox | vb | worldState resetDamageRecorder. "since we may have moved, old data no longer valid" ((vb := self viewBox) isNil or: [vb ~= newViewBox]) ifTrue: [worldState canvas: nil]. worldState viewBox: newViewBox. self bounds: newViewBox. "works better here than simply storing into bounds" worldState assuredCanvas. "Paragraph problem workaround; clear selections to avoid screen droppings:" self flag: #arNote. "Probably unnecessary" worldState handsDo: [:h | h releaseKeyboardFocus]. self fullRepaintNeeded! ----- Method: MVCWiWPasteUpMorph>>worldUnderCursor (in category 'as yet unclassified') ----- worldUnderCursor ^self! ----- Method: WiWPasteUpMorph class>>say: (in category 'as yet unclassified') ----- say: x (Debug ifNil: [Debug := OrderedCollection new]) add: x asString,' '. Debug size > 500 ifTrue: [Debug := Debug copyFrom: 200 to: Debug size]! ----- Method: WiWPasteUpMorph class>>show (in category 'as yet unclassified') ----- show Debug inspect. Debug := OrderedCollection new.! ----- Method: WiWPasteUpMorph>>becomeTheActiveWorldWith: (in category 'activation') ----- becomeTheActiveWorldWith: evt "Make the receiver become the active world, and give its hand the event provided, if not nil" | outerWorld | World == self ifTrue: [^ self]. worldState resetDamageRecorder. "since we may have moved, old data no longer valid" hostWindow setStripeColorsFrom: Color green. worldState canvas: nil. "safer to start from scratch" displayChangeSignatureOnEntry := Display displayChangeSignature. "Messy stuff to clear flaps from outer world" Flaps globalFlapTabsIfAny do: [:f | f changed]. outerWorld := World. World := self. self installFlaps. World := outerWorld. outerWorld displayWorld. World := self. self viewBox: hostWindow panelRect. self startSteppingSubmorphsOf: self. self changed. pendingEvent := nil. evt ifNotNil: [self primaryHand handleEvent: (evt setHand: self primaryHand)]. ! ----- Method: WiWPasteUpMorph>>displayWorld (in category 'world state') ----- displayWorld "RAA 27 Nov 99 - if we are not active, then the parent should do the drawing" self flag: #bob. "probably not needed" World == self ifTrue: [^super displayWorld]. parentWorld ifNotNil: [^parentWorld displayWorld]. ^super displayWorld "in case MVC needs it"! ----- Method: WiWPasteUpMorph>>doDeferredUpdating (in category 'update cycle') ----- doDeferredUpdating "If this platform supports deferred updates, then make my canvas be the Display (or a rectangular portion of it), set the Display to deferred update mode, and answer true. Otherwise, do nothing and answer false. One can set the class variable DisableDeferredUpdates to true to completely disable the deferred updating feature." PasteUpMorph disableDeferredUpdates ifTrue: [^ false]. (Display deferUpdates: true) ifNil: [^ false]. "deferred updates not supported" self resetViewBox. ^ true ! ----- Method: WiWPasteUpMorph>>doOneCycle (in category 'world state') ----- doOneCycle pendingEvent ifNotNil: [ self primaryHand handleEvent: (pendingEvent setHand: self primaryHand). pendingEvent := nil. ]. ^super doOneCycle.! ----- Method: WiWPasteUpMorph>>extent: (in category 'geometry') ----- extent: x super extent: x. self resetViewBox.! ----- Method: WiWPasteUpMorph>>goBack (in category 'world state') ----- goBack "Return to the previous project. For the moment, this is not allowed from inner worlds" self inform: 'Project changes are not yet allowed from inner worlds.'! ----- Method: WiWPasteUpMorph>>hostWindow: (in category 'initialization') ----- hostWindow: x hostWindow := x. worldState canvas: nil. "safer to start from scratch" self viewBox: hostWindow panelRect. ! ----- Method: WiWPasteUpMorph>>initialize (in category 'initialization') ----- initialize super initialize. parentWorld := World. ! ----- Method: WiWPasteUpMorph>>jumpToProject (in category 'world state') ----- jumpToProject "Jump directly to another project. However, this is not currently allowed for inner worlds" self inform: 'Project changes are not yet allowed from inner worlds.'! ----- Method: WiWPasteUpMorph>>mouseDown: (in category 'event handling') ----- mouseDown: evt (World == self or: [World isNil]) ifTrue: [^ super mouseDown: evt]. (self bounds containsPoint: evt cursorPoint) ifFalse: [^ self]. self becomeTheActiveWorldWith: evt. ! ----- Method: WiWPasteUpMorph>>resetViewBox (in category 'geometry') ----- resetViewBox | c | (c := worldState canvas) isNil ifTrue: [^self resetViewBoxForReal]. c form == Display ifFalse: [^self resetViewBoxForReal]. c origin = (0 @ 0) ifFalse: [^self resetViewBoxForReal]. c clipRect extent = (self viewBox intersect: parentWorld viewBox) extent ifFalse: [^self resetViewBoxForReal]! ----- Method: WiWPasteUpMorph>>resetViewBoxForReal (in category 'geometry') ----- resetViewBoxForReal | newClip | self viewBox ifNil: [^self]. newClip := self viewBox intersect: parentWorld viewBox. worldState canvas: ( Display getCanvas copyOffset: 0 at 0 clipRect: newClip )! ----- Method: WiWPasteUpMorph>>restartWorldCycleWithEvent: (in category 'WiW support') ----- restartWorldCycleWithEvent: evt "redispatch that click in outer world" pendingEvent := evt. Project spawnNewProcessAndTerminateOld: true ! ----- Method: WiWPasteUpMorph>>restoreDisplay (in category 'world state') ----- restoreDisplay World ifNotNil:[World restoreMorphicDisplay]. "I don't actually expect this to be called"! ----- Method: WiWPasteUpMorph>>revertToParentWorldWithEvent: (in category 'activation') ----- revertToParentWorldWithEvent: evt "RAA 27 Nov 99 - if the display changed while we were in charge, parent may need to redraw" worldState resetDamageRecorder. "Terminate local display" World := parentWorld. World assuredCanvas. World installFlaps. hostWindow setStripeColorsFrom: Color red. (displayChangeSignatureOnEntry = Display displayChangeSignature) ifFalse: [ World fullRepaintNeeded; displayWorld ]. evt ifNotNil: [World restartWorldCycleWithEvent: evt]. ! ----- Method: WiWPasteUpMorph>>validateMouseEvent: (in category 'WiW support') ----- validateMouseEvent: evt evt isMouseDown ifFalse: [^ self]. "any click outside returns us to our home world" (self bounds containsPoint: evt cursorPoint) ifFalse: [ self revertToParentWorldWithEvent: evt. ].! ----- Method: WiWPasteUpMorph>>viewBox: (in category 'project state') ----- viewBox: newViewBox | vb | worldState resetDamageRecorder. "since we may have moved, old data no longer valid" ((vb := self viewBox) isNil or: [vb ~= newViewBox]) ifTrue: [worldState canvas: nil]. worldState viewBox: newViewBox. bounds := newViewBox. worldState assuredCanvas. "Paragraph problem workaround; clear selections to avoid screen droppings:" self flag: #arNote. "Probably unnecessary" worldState handsDo: [:h | h releaseKeyboardFocus]. self fullRepaintNeeded! Object subclass: #WorldViewModel instanceVariableNames: 'initialExtent' classVariableNames: '' poolDictionaries: '' category: 'MorphicWiW-ST80'! !WorldViewModel commentStamp: '<historical>' prior: 0! Serves as a model for a WorldView -- a morphic world viewed within an mvc project.! WorldViewModel subclass: #CautiousModel instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'MorphicWiW-ST80'! !CautiousModel commentStamp: '<historical>' prior: 0! A model for a morphic world view which will ask for confirmation before being closed, unless the corresponding preference is set to false. ! ----- Method: CautiousModel>>okToChange (in category 'updating') ----- okToChange Preferences cautionBeforeClosing ifFalse: [^ true]. Sensor leftShiftDown ifTrue: [^ true]. Beeper beep. ^ self confirm: 'Warning!! If you answer "yes" here, this window will disappear and its contents will be lost!! Do you really want to do that?' "CautiousModel new okToChange"! ----- Method: WorldViewModel>>fullScreenSize (in category 'user interface') ----- fullScreenSize "Answer the size to which a window displaying the receiver should be set" ^ (0 at 0 extent: DisplayScreen actualScreenSize) copy! ----- Method: WorldViewModel>>initialExtent (in category 'user interface') ----- initialExtent initialExtent ifNotNil: [^ initialExtent]. ^ super initialExtent! ----- Method: WorldViewModel>>initialExtent: (in category 'as yet unclassified') ----- initialExtent: anExtent initialExtent := anExtent!
More information about the Squeak-dev mailing list |