'From Squeak 1.23 of October 4, 1997 on 14 November 1997 at 11:25:26 am'! "Change Set: MorphicPlumbin Date: 14 November 1997 Author: Hans-Martin Mosner Prerequisite: Plumbin' (http://c2.com/doc/plumbin/) This changeset converts the original Plumbin' for Squeak into a Morphic version. You need to load all three Plumbin' files because 2 methods for PressureTank are added. A new kind of Tile (BrokenElbowTile) is implemented to break cycles. It displays itself with a gray overlay, and has a menu item to 'fix' it (convert back to ElbowTile). To start, execute 'Tile exampleMorphic' Enjoy, Hans-Martin "! Morph subclass: #Tile instanceVariableNames: 'left top right bottom ' classVariableNames: 'MaxLoops ' poolDictionaries: '' category: 'Plumbin-Framework'! ElbowPipe subclass: #BrokenElbowPipe instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Plumbin-StandardTiles'! !Tile methodsFor: 'initialize' stamp: 'hmm 11/14/97 09:35'! initialize "Initialize the receiver's neighbors to be emptyTiles." super initialize. self extent: 40@40. self color: nil. top _ Tile emptyTile. bottom _ Tile emptyTile. left _ Tile emptyTile. right _ Tile emptyTile.! ! !Tile methodsFor: 'drawing' stamp: 'hmm 11/14/97 09:36'! drawOn: aCanvas aCanvas image: self form at: self position! ! !Tile methodsFor: 'checking' stamp: 'hmm 11/14/97 09:57'! loopCheck "Check for loops in change, pressure or flow. By convention we only check while going around the upper-right corner of a loop (see ElboPipe)." (MaxLoops _ MaxLoops - 1) < 1 ifTrue: [self break. self resetLoopCheck] ! ! !Tile methodsFor: 'geometry' stamp: 'hmm 11/14/97 09:41'! moveBy: aPoint | newPosition | self isInWorld ifFalse: [^super moveBy: aPoint]. newPosition := (self position + aPoint + (20@20)) truncateTo: 40@40. super moveBy: newPosition - self position! ! !Tile methodsFor: 'copying' stamp: 'hmm 11/14/97 10:23'! clearNeighbors top _ Tile emptyTile. bottom _ Tile emptyTile. left _ Tile emptyTile. right _ Tile emptyTile.! ! !Tile methodsFor: 'copying' stamp: 'hmm 11/14/97 10:26'! clone "Need to clear out neighbors before resetting owner" ^super clone clearNeighbors! ! !Tile methodsFor: 'private' stamp: 'hmm 11/14/97 09:57'! break "Convert into a 'broken' tile if possible. Classes which use loopCheck should implement this." self subclassResponsibility! ! !Tile methodsFor: 'private' stamp: 'hmm 11/14/97 10:50'! changeClass: aTileClass | tile | self class == aTileClass ifTrue: [^self]. tile _ aTileClass basicNew. 1 to: aTileClass instSize do: [:i | tile instVarAt: i put: (self instVarAt: i)]. self become: tile. self changed. self changeAll! ! !Tile methodsFor: 'private' stamp: 'hmm 11/14/97 10:18'! connect "Connect the tile to adjacent tiles" | tile | tile _ self relativeTile: 0@0 ifAbsent: []. tile == nil ifFalse: ["replacing a tile" tile disconnect. tile delete]. tile _ self relativeTile: -1@0. self left: tile. tile right: self. tile _ self relativeTile: 1@0. self right: tile. tile left: self. tile _ self relativeTile: 0@-1. self top: tile. tile bottom: self. tile _ self relativeTile: 0@1. self bottom: tile. tile top: self. self changed. self changeAll! ! !Tile methodsFor: 'private' stamp: 'hmm 11/14/97 09:44'! disconnect "Disconnect the tile from all adjacent tiles" top bottom: Tile emptyTile. bottom top: Tile emptyTile. left right: Tile emptyTile. right left: Tile emptyTile. self changeAll. top _ Tile emptyTile. bottom _ Tile emptyTile. left _ Tile emptyTile. right _ Tile emptyTile. self changed! ! !Tile methodsFor: 'private' stamp: 'hmm 11/14/97 09:40'! isInWorld ^owner notNil and: [owner isWorldMorph]! ! !Tile methodsFor: 'private' stamp: 'hmm 11/14/97 09:49'! privateOwner: aMorph super privateOwner: aMorph. self isInWorld ifTrue: [ self moveBy: 0@0. "adjust position to grid" self connect] ifFalse: [ self disconnect]! ! !Tile methodsFor: 'private' stamp: 'hmm 11/14/97 09:48'! relativeTile: aPoint ^self relativeTile: aPoint ifAbsent: [Tile emptyTile]! ! !Tile methodsFor: 'private' stamp: 'hmm 11/14/97 09:48'! relativeTile: aPoint ifAbsent: aBlock | p | p := aPoint * 40 + self position. ^owner submorphs detect: [:each | each position = p and: [each isKindOf: Tile]] ifNone: aBlock! ! !ElbowPipe methodsFor: 'updating' stamp: 'hmm 11/14/97 09:53'! changed self resetLoopCheck. super changed! ! !ElbowPipe methodsFor: 'stepping' stamp: 'hmm 11/14/97 09:55'! step self resetLoopCheck! ! !ElbowPipe methodsFor: 'private' stamp: 'hmm 11/14/97 10:49'! break self changeClass: BrokenElbowPipe! ! !BrokenElbowPipe reorganize! ('accessing' fix) ('drawing' drawOn:) ('simulating' bottomFlow bottomPressure leftFlow leftPressure) ('updating' bottomChanged leftChanged) ('menu' addCustomMenuItems:hand:) ! !BrokenElbowPipe methodsFor: 'accessing' stamp: 'hmm 11/14/97 10:50'! fix self changeClass: ElbowPipe! ! !BrokenElbowPipe methodsFor: 'drawing' stamp: 'hmm 11/14/97 10:02'! drawOn: aCanvas super drawOn: aCanvas. (aCanvas copyForShadowDrawingOffset: 0@0) fillRectangle: self bounds color: Color black! ! !BrokenElbowPipe methodsFor: 'simulating' stamp: 'hmm 11/14/97 10:14'! bottomFlow "This tile is broken, don't forward" ^0.0! ! !BrokenElbowPipe methodsFor: 'simulating' stamp: 'hmm 11/14/97 10:14'! bottomPressure "This tile is broken, don't forward" ^0.0! ! !BrokenElbowPipe methodsFor: 'simulating' stamp: 'hmm 11/14/97 10:14'! leftFlow "This tile is broken, don't forward" ^0.0! ! !BrokenElbowPipe methodsFor: 'simulating' stamp: 'hmm 11/14/97 10:14'! leftPressure "This tile is broken, don't forward" ^0.0! ! !BrokenElbowPipe methodsFor: 'updating' stamp: 'hmm 11/14/97 10:34'! bottomChanged "Tile is broken, don't propagate" ! ! !BrokenElbowPipe methodsFor: 'updating' stamp: 'hmm 11/14/97 10:34'! leftChanged "Tile is broken, don't propagate" ! ! !BrokenElbowPipe methodsFor: 'menu' stamp: 'hmm 11/14/97 10:37'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu add: 'fix' action: #fix! ! !Faucet reorganize! ('accessing' form off on) ('simulating' bottomFlow bottomPressure) ('defaults' defaultControllerClass) ('menu' addCustomMenuItems:hand:) ('drawing' drawOn:) ! !Faucet methodsFor: 'accessing' stamp: 'hmm 11/14/97 11:06'! off "Turn off the receiver. Propogate the change." open _ false. self changed. bottom topChanged.! ! !Faucet methodsFor: 'accessing' stamp: 'hmm 11/14/97 11:06'! on "Turn on the receiver. Propagate the change." open _ true. self changed. bottom topChanged.! ! !Faucet methodsFor: 'menu' stamp: 'hmm 11/14/97 10:30'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. open ifTrue: [aCustomMenu add: 'off' action: #off] ifFalse: [aCustomMenu add: 'on' action: #on]! ! !Faucet methodsFor: 'drawing' stamp: 'hmm 11/14/97 11:07'! drawOn: aCanvas "Give an indication that the faucet is closed" | box | super drawOn: aCanvas. open ifFalse: [ box := self bounds insetBy: 6. aCanvas line: box topLeft to: box bottomRight width: 2 color: Color red. aCanvas line: box topRight to: box bottomLeft width: 2 color: Color red]! ! !PressureTank methodsFor: 'simulating' stamp: 'hmm 11/14/97 11:11'! step volume _ (volume + self bottomFlow max: 1.0) min: self capacity. self changed. self resetLoopCheck. bottom topChanged.! ! !PressureTank methodsFor: 'simulating' stamp: 'hmm 11/14/97 11:11'! stepTime ^100! ! !Spout methodsFor: 'simulating' stamp: 'hmm 11/14/97 10:16'! topFlow "Answer the fluid flow out the top of the receiver." self resetLoopCheck. ^top bottomPressure negated! ! !Tile class methodsFor: 'examples' stamp: 'hmm 11/14/97 11:00'! exampleMorphic "Tile exampleMorphic" | world parts partsContainer | world _ WorldMorph new. parts _ PartsBinMorph new borderWidth: 1; borderColor: #inset; color: Color white. self allSubclasses do: [:each | parts addMorphBack: each new]. partsContainer _ LayoutMorph new orientation: #vertical; centering: #center; color: (Color r: 0.5 g: 0.5 b: 0.75); hResizing: #shrinkWrap; vResizing: #shrinkWrap; borderWidth: 2; inset: 3; borderColor: #raised. partsContainer addMorphBack: (StringMorph contents: 'Plumbin'' palette'). partsContainer addMorphBack: parts. partsContainer position: 10@10. world addMorph: partsContainer. world openWithTitle: 'Morphic Plumbin'''! !