Packages January 2019

packages@lists.squeakfoundation.org

1 participants
90 discussions

The Trunk: Collections-JH.814.mcz
by commits＠source.squeak.org 25 Jan '19

25 Jan '19

Marcel Taeumel uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-JH.814.mcz ==================== Summary ==================== Name: Collections-JH.814 Author: JH Time: 24 January 2019, 10:32:33.157023 am UUID: 2981cec1-a155-7840-bbff-827a8f3387bb Ancestors: Collections-eem.806 Add check to FloatArray primitive fallback code to ensure that receiver and argument have the same size (argument was previously allowed to be larger than receiver, which does not make sense mathematically). =============== Diff against Collections-eem.806 =============== Item was changed: ----- Method: FloatArray>>primAddArray: (in category 'primitives-plugin') ----- primAddArray: floatArray <primitive: 'primitiveAddFloatArray' module: 'FloatArrayPlugin'> + self size = floatArray size ifFalse:[^self error:'Must be equal size']. 1 to: self size do:[:i| self at: i put: (self at: i) + (floatArray at: i)].! Item was changed: ----- Method: FloatArray>>primDivArray: (in category 'primitives-plugin') ----- primDivArray: floatArray <primitive: 'primitiveDivFloatArray' module: 'FloatArrayPlugin'> + self size = floatArray size ifFalse:[^self error:'Must be equal size']. 1 to: self size do:[:i| self at: i put: (self at: i) / (floatArray at: i)].! Item was changed: ----- Method: FloatArray>>primMulArray: (in category 'primitives-plugin') ----- primMulArray: floatArray <primitive: 'primitiveMulFloatArray' module: 'FloatArrayPlugin'> + self size = floatArray size ifFalse:[^self error:'Must be equal size']. 1 to: self size do:[:i| self at: i put: (self at: i) * (floatArray at: i)].! Item was changed: ----- Method: FloatArray>>primSubArray: (in category 'primitives-plugin') ----- primSubArray: floatArray <primitive: 'primitiveSubFloatArray' module: 'FloatArrayPlugin'> + self size = floatArray size ifFalse:[^self error:'Must be equal size']. 1 to: self size do:[:i| self at: i put: (self at: i) - (floatArray at: i)].!

1 0

The Trunk: CollectionsTests-mt.299.mcz
by commits＠source.squeak.org 25 Jan '19

25 Jan '19

Marcel Taeumel uploaded a new version of CollectionsTests to project The Trunk: http://source.squeak.org/trunk/CollectionsTests-mt.299.mcz ==================== Summary ==================== Name: CollectionsTests-mt.299 Author: mt Time: 25 January 2019, 9:15:00.435997 am UUID: 8ca1214a-4ba0-b94b-b27d-a26311064015 Ancestors: CollectionsTests-cbc.296, CollectionsTests-JH.298 Merges CollectionsTests-JH.298 =============== Diff against CollectionsTests-cbc.296 =============== Item was added: + ----- Method: FloatArrayTest>>testVectorOperations (in category 'testing') ----- + testVectorOperations + + "Test primtive cases 'receiver size = argument size'." + self assert: (FloatArray withAll: {2.0. 2.0}) equals: (FloatArray withAll: {4.0. 6.0}) / (FloatArray withAll: {2.0. 3.0}). + self assert: (FloatArray withAll: {8.0. 9.0}) equals: (FloatArray withAll: {4.0. 4.5}) * (FloatArray withAll: {2.0. 2.0}). + self assert: (FloatArray withAll: {6.0. 9.0}) equals: (FloatArray withAll: {4.0. 6.0}) + (FloatArray withAll: {2.0. 3.0}). + self assert: (FloatArray withAll: {2.0. 3.0}) equals: (FloatArray withAll: {4.0. 6.0}) - (FloatArray withAll: {2.0. 3.0}). + self assert: 26 equals: ((FloatArray withAll: {4.0. 6.0}) dot: (FloatArray withAll: {2.0. 3.0})). + + "Test corner cases where 'receiver size < argument size'." + self should: [(FloatArray withAll: {4.0. 6.0}) / (FloatArray withAll: {2.0. 3.0. 42.0})] raise: Error. + self should: [(FloatArray withAll: {4.0. 6.0}) * (FloatArray withAll: {2.0. 3.0. 42.0})] raise: Error. + self should: [(FloatArray withAll: {4.0. 6.0}) + (FloatArray withAll: {2.0. 3.0. 42.0})] raise: Error. + self should: [(FloatArray withAll: {4.0. 6.0}) - (FloatArray withAll: {2.0. 3.0. 42.0})] raise: Error. + self should: [(FloatArray withAll: {4.0. 6.0}) dot: (FloatArray withAll: {2.0. 3.0. 42.0})] raise: Error. + + "Test corner cases where 'receiver size > argument size'." + self should: [(FloatArray withAll: {4.0. 6.0. 42.0}) / (FloatArray withAll: {2.0. 3.0})] raise: Error. + self should: [(FloatArray withAll: {4.0. 6.0. 42.0}) * (FloatArray withAll: {2.0. 3.0})] raise: Error. + self should: [(FloatArray withAll: {4.0. 6.0. 42.0}) + (FloatArray withAll: {2.0. 3.0})] raise: Error. + self should: [(FloatArray withAll: {4.0. 6.0. 42.0}) - (FloatArray withAll: {2.0. 3.0})] raise: Error. + self should: [(FloatArray withAll: {4.0. 6.0. 42.0}) dot: (FloatArray withAll: {2.0. 3.0})] raise: Error. + + + + !

1 0

The Trunk: Collections-mt.815.mcz
by commits＠source.squeak.org 25 Jan '19

25 Jan '19

Marcel Taeumel uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-mt.815.mcz ==================== Summary ==================== Name: Collections-mt.815 Author: mt Time: 25 January 2019, 9:14:33.882997 am UUID: 84a9d4dc-2c9e-4b48-84b9-66254895c0bb Ancestors: Collections-mt.812, Collections-JH.814 Merges Collections-JH.814 =============== Diff against Collections-eem.811 =============== Item was added: + ----- Method: Collection>>try: (in category 'enumerating') ----- + try: aBlock + "Evaluate aBlock with each of the receiver's elements as the argument. On error, skip that element and continue." + + ^ self try: aBlock ignore: Error! Item was added: + ----- Method: Collection>>try:ignore: (in category 'enumerating') ----- + try: aBlock ignore: exceptionOrExceptionSet + "Evaluate aBlock with each of the receiver's elements as the argument. On error, skip that element and continue." + + ^ self + try: aBlock + ignore: exceptionOrExceptionSet + logged: false! Item was added: + ----- Method: Collection>>try:ignore:logged: (in category 'enumerating') ----- + try: aBlock ignore: exceptionOrExceptionSet logged: aBoolean + "Evaluate aBlock with each of the receiver's elements as the argument. On error, skip that element and continue." + + ^ self do: [:ea | + [aBlock value: ea] + on: exceptionOrExceptionSet + do: [:err | aBoolean ifTrue: [Transcript showln: err messageText]]]! Item was changed: ----- Method: FloatArray>>primAddArray: (in category 'primitives-plugin') ----- primAddArray: floatArray <primitive: 'primitiveAddFloatArray' module: 'FloatArrayPlugin'> + self size = floatArray size ifFalse:[^self error:'Must be equal size']. 1 to: self size do:[:i| self at: i put: (self at: i) + (floatArray at: i)].! Item was changed: ----- Method: FloatArray>>primDivArray: (in category 'primitives-plugin') ----- primDivArray: floatArray <primitive: 'primitiveDivFloatArray' module: 'FloatArrayPlugin'> + self size = floatArray size ifFalse:[^self error:'Must be equal size']. 1 to: self size do:[:i| self at: i put: (self at: i) / (floatArray at: i)].! Item was changed: ----- Method: FloatArray>>primMulArray: (in category 'primitives-plugin') ----- primMulArray: floatArray <primitive: 'primitiveMulFloatArray' module: 'FloatArrayPlugin'> + self size = floatArray size ifFalse:[^self error:'Must be equal size']. 1 to: self size do:[:i| self at: i put: (self at: i) * (floatArray at: i)].! Item was changed: ----- Method: FloatArray>>primSubArray: (in category 'primitives-plugin') ----- primSubArray: floatArray <primitive: 'primitiveSubFloatArray' module: 'FloatArrayPlugin'> + self size = floatArray size ifFalse:[^self error:'Must be equal size']. 1 to: self size do:[:i| self at: i put: (self at: i) - (floatArray at: i)].!

1 0

The Trunk: Tests-pre.407.mcz
by commits＠source.squeak.org 24 Jan '19

24 Jan '19

Patrick Rein uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-pre.407.mcz ==================== Summary ==================== Name: Tests-pre.407 Author: pre Time: 24 January 2019, 5:33:33.982474 pm UUID: cc0561a0-4ea8-4a46-898a-08d548a820e9 Ancestors: Tests-tpr.406 Reverts a re-categorization of a method in a Monticello mock class as the previous category was relevant for some test cases. =============== Diff against Tests-tpr.406 =============== Item was changed: + ----- Method: MCMockClassA>>d (in category 'as yet classified') ----- - ----- Method: MCMockClassA>>d (in category 'numeric') ----- d ^ 'd'!

1 0

The Trunk: Morphic-pre.1476.mcz
by commits＠source.squeak.org 24 Jan '19

24 Jan '19

Patrick Rein uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-pre.1476.mcz ==================== Summary ==================== Name: Morphic-pre.1476 Author: pre Time: 24 January 2019, 5:06:02.544474 pm UUID: dec0ceb0-45f0-614e-829c-3e940506657a Ancestors: Morphic-mt.1475 Recategorizes the fitContents method consistently throughout Morphic =============== Diff against Morphic-mt.1475 =============== Item was changed: + ----- Method: IndentingListItemMorph>>fitContents (in category 'layout') ----- - ----- Method: IndentingListItemMorph>>fitContents (in category 'accessing') ----- fitContents super fitContents. self width: container preferredSubmorphWidth.! Item was changed: + ----- Method: SimpleButtonMorph>>fitContents (in category 'layout') ----- - ----- Method: SimpleButtonMorph>>fitContents (in category 'accessing') ----- fitContents | aMorph aCenter | aCenter := self center. self hasSubmorphs ifFalse: [^self]. aMorph := self firstSubmorph. self extent: aMorph extent + (self borderWidth + 6). self center: aCenter. aMorph position: aCenter - (aMorph extent // 2)! Item was changed: + ----- Method: StringMorph>>fitContents (in category 'layout') ----- - ----- Method: StringMorph>>fitContents (in category 'accessing') ----- fitContents | newBounds boundsChanged | newBounds := self measureContents. boundsChanged := bounds extent ~= newBounds. self extent: newBounds. "default short-circuits if bounds not changed" boundsChanged ifFalse: [self changed]! Item was changed: + ----- Method: UpdatingStringMorph>>fitContents (in category 'layout') ----- - ----- Method: UpdatingStringMorph>>fitContents (in category 'accessing') ----- fitContents | newExtent | newExtent := self measureContents. newExtent := ((newExtent x max: self minimumWidth) min: self maximumWidth) @ newExtent y. (self extent = newExtent) ifFalse: [self extent: newExtent. self changed] !

1 0

The Trunk: MorphicExtras-pre.251.mcz
by commits＠source.squeak.org 24 Jan '19

24 Jan '19

Patrick Rein uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-pre.251.mcz ==================== Summary ==================== Name: MorphicExtras-pre.251 Author: pre Time: 24 January 2019, 5:03:07.198474 pm UUID: 2ce22615-871b-834b-b39e-e6e22cddc4c3 Ancestors: MorphicExtras-tpr.250 Recategorizes methods throughout MorphicExtras. Removes one method which was already marked for deletion. =============== Diff against MorphicExtras-tpr.250 =============== Item was changed: + ----- Method: AlignmentMorphBob1>>acceptDroppingMorph:event: (in category 'dropping/grabbing') ----- - ----- Method: AlignmentMorphBob1>>acceptDroppingMorph:event: (in category 'as yet unclassified') ----- acceptDroppingMorph: aMorph event: evt | handlerForDrops | handlerForDrops := self valueOfProperty: #handlerForDrops ifAbsent: [ ^super acceptDroppingMorph: aMorph event: evt ]. (handlerForDrops acceptDroppingMorph: aMorph event: evt inMorph: self) ifFalse: [ aMorph rejectDropMorphEvent: evt. "send it back where it came from" ].! Item was changed: + ----- Method: AlignmentMorphBob1>>addAColumn: (in category 'ui construction') ----- - ----- Method: AlignmentMorphBob1>>addAColumn: (in category 'as yet unclassified') ----- addAColumn: aCollectionOfMorphs | col | col := self inAColumn: aCollectionOfMorphs. self addMorphBack: col. ^col! Item was changed: + ----- Method: AlignmentMorphBob1>>addARow: (in category 'ui construction') ----- - ----- Method: AlignmentMorphBob1>>addARow: (in category 'as yet unclassified') ----- addARow: aCollectionOfMorphs | row | row := self inARow: aCollectionOfMorphs. self addMorphBack: row. ^row! Item was changed: + ----- Method: AlignmentMorphBob1>>addARowCentered: (in category 'ui construction') ----- - ----- Method: AlignmentMorphBob1>>addARowCentered: (in category 'as yet unclassified') ----- addARowCentered: aCollectionOfMorphs ^(self addARow: aCollectionOfMorphs) hResizing: #shrinkWrap; wrapCentering: #center; cellPositioning: #leftCenter! Item was changed: + ----- Method: AlignmentMorphBob1>>addARowCentered:cellInset: (in category 'ui construction') ----- - ----- Method: AlignmentMorphBob1>>addARowCentered:cellInset: (in category 'as yet unclassified') ----- addARowCentered: aCollectionOfMorphs cellInset: cellInsetInteger ^(self addARow: aCollectionOfMorphs) hResizing: #shrinkWrap; wrapCentering: #center; cellPositioning: #leftCenter; cellInset: cellInsetInteger! Item was changed: + ----- Method: AlignmentMorphBob1>>fancyText:font:color: (in category 'ui construction') ----- - ----- Method: AlignmentMorphBob1>>fancyText:font:color: (in category 'as yet unclassified') ----- fancyText: aString font: aFont color: aColor | answer tm col | col := Preferences menuAppearance3d ifTrue: [aColor] ifFalse: [aColor negated]. tm := TextMorph new. tm beAllFont: aFont; color: col; contents: aString. answer := self inAColumn: {tm}. Preferences menuAppearance3d ifTrue: ["" tm addDropShadow. tm shadowPoint: 5 @ 5 + tm bounds center]. tm lock. ^ answer! Item was changed: + ----- Method: AlignmentMorphBob1>>fullDrawOn: (in category 'drawing') ----- - ----- Method: AlignmentMorphBob1>>fullDrawOn: (in category 'as yet unclassified') ----- fullDrawOn: aCanvas | mask | (aCanvas isVisible: self fullBounds) ifFalse:[^self]. super fullDrawOn: aCanvas. mask := self valueOfProperty: #disabledMaskColor ifAbsent: [^self]. aCanvas fillRectangle: bounds color: mask. ! Item was changed: + ----- Method: AlignmentMorphBob1>>inAColumn: (in category 'ui construction') ----- - ----- Method: AlignmentMorphBob1>>inAColumn: (in category 'as yet unclassified') ----- inAColumn: aCollectionOfMorphs | col | col := AlignmentMorph newColumn color: Color transparent; vResizing: #shrinkWrap; layoutInset: 1; wrapCentering: #center; cellPositioning: #topCenter. aCollectionOfMorphs do: [ :each | col addMorphBack: each]. ^col! Item was changed: + ----- Method: AlignmentMorphBob1>>inARightColumn: (in category 'ui construction') ----- - ----- Method: AlignmentMorphBob1>>inARightColumn: (in category 'as yet unclassified') ----- inARightColumn: aCollectionOfMorphs | col | col := AlignmentMorph newColumn color: Color transparent; vResizing: #shrinkWrap; layoutInset: 1; wrapCentering: #bottomRight; cellPositioning: #topCenter. aCollectionOfMorphs do: [:each | col addMorphBack: each]. ^ col! Item was changed: + ----- Method: AlignmentMorphBob1>>inARow: (in category 'ui construction') ----- - ----- Method: AlignmentMorphBob1>>inARow: (in category 'as yet unclassified') ----- inARow: aCollectionOfMorphs | row | row := AlignmentMorph newRow color: Color transparent; vResizing: #shrinkWrap; layoutInset: 2; wrapCentering: #center; cellPositioning: #leftCenter. aCollectionOfMorphs do: [:each | each ifNotNil: [row addMorphBack: each]]. ^ row! Item was changed: + ----- Method: AlignmentMorphBob1>>simpleToggleButtonFor:attribute:help: (in category 'ui construction') ----- - ----- Method: AlignmentMorphBob1>>simpleToggleButtonFor:attribute:help: (in category 'as yet unclassified') ----- simpleToggleButtonFor: target attribute: attribute help: helpText ^(Smalltalk at: #EtoyUpdatingThreePhaseButtonMorph ifAbsent:[^Morph new]) checkBox target: target; actionSelector: #toggleChoice:; arguments: {attribute}; getSelector: #getChoice:; setBalloonText: helpText; step ! Item was changed: + ----- Method: AlignmentMorphBob1>>wantsDroppedMorph:event: (in category 'dropping/grabbing') ----- - ----- Method: AlignmentMorphBob1>>wantsDroppedMorph:event: (in category 'as yet unclassified') ----- wantsDroppedMorph: aMorph event: evt | handlerForDrops | handlerForDrops := self valueOfProperty: #handlerForDrops ifAbsent: [ ^super wantsDroppedMorph: aMorph event: evt ]. ^handlerForDrops wantsDroppedMorph: aMorph event: evt inMorph: self! Item was changed: + ----- Method: BOBTransformationMorph>>changeWorldBoundsToShow: (in category 'geometry') ----- - ----- Method: BOBTransformationMorph>>changeWorldBoundsToShow: (in category 'as yet unclassified') ----- changeWorldBoundsToShow: aRectangle aRectangle area = 0 ifTrue: [^self]. worldBoundsToShow := aRectangle. owner myWorldChanged.! Item was changed: + ----- Method: BOBTransformationMorph>>drawSubmorphsOnREAL: (in category 'drawing') ----- - ----- Method: BOBTransformationMorph>>drawSubmorphsOnREAL: (in category 'as yet unclassified') ----- drawSubmorphsOnREAL: aCanvas | newClip | (self innerBounds intersects: aCanvas clipRect) ifFalse: [^self]. newClip := ((self innerBounds intersect: aCanvas clipRect) expandBy: 1) truncated. useRegularWarpBlt == true ifTrue: [ transform scale asFloat = 1.0 ifFalse: [ newClip := self innerBounds. "avoids gribblies" ]. ^aCanvas transformBy: transform clippingTo: newClip during: [:myCanvas | submorphs reverseDo:[:m | myCanvas fullDrawMorph: m] ] smoothing: smoothing ]. aCanvas transform2By: transform "#transformBy: for pure WarpBlt" clippingTo: newClip during: [:myCanvas | submorphs reverseDo:[:m | myCanvas fullDrawMorph: m] ] smoothing: smoothing ! Item was changed: + ----- Method: BOBTransformationMorph>>extentFromParent: (in category 'geometry') ----- - ----- Method: BOBTransformationMorph>>extentFromParent: (in category 'as yet unclassified') ----- extentFromParent: aPoint | newExtent | submorphs isEmpty ifTrue: [^self extent: aPoint]. newExtent := aPoint truncated. bounds := bounds topLeft extent: newExtent. newExtent := self recomputeExtent. newExtent ifNil: [^self]. bounds := bounds topLeft extent: newExtent. ! Item was changed: + ----- Method: BOBTransformationMorph>>recomputeExtent (in category 'private') ----- - ----- Method: BOBTransformationMorph>>recomputeExtent (in category 'as yet unclassified') ----- recomputeExtent | scalePt newScale theGreenThingie greenIBE myNewExtent | submorphs isEmpty ifTrue: [^self extent]. worldBoundsToShow ifNil: [worldBoundsToShow := self firstSubmorph bounds]. worldBoundsToShow area = 0 ifTrue: [^self extent]. scalePt := owner innerBounds extent / worldBoundsToShow extent. newScale := scalePt x min: scalePt y. theGreenThingie := owner. greenIBE := theGreenThingie innerBounds extent. myNewExtent := (greenIBE min: worldBoundsToShow extent * newScale) truncated. self scale: newScale; offset: worldBoundsToShow origin * newScale. smoothing := (newScale < 1.0) ifTrue: [2] ifFalse: [1]. ^myNewExtent! Item was changed: + ----- Method: BOBTransformationMorph>>useRegularWarpBlt: (in category 'accessing') ----- - ----- Method: BOBTransformationMorph>>useRegularWarpBlt: (in category 'as yet unclassified') ----- useRegularWarpBlt: aBoolean useRegularWarpBlt := aBoolean! Item was changed: + ----- Method: BackgroundMorph class>>test (in category 'test') ----- - ----- Method: BackgroundMorph class>>test (in category 'as yet unclassified') ----- test "BackgroundMorph test" ^(BackgroundMorph new addMorph: (ImageMorph new image: Form fromUser))openInWorld.! Item was changed: + ----- Method: BasicButton>>label (in category 'label') ----- - ----- Method: BasicButton>>label (in category 'as yet unclassified') ----- label | s | s := ''. self allMorphsDo: [:m | (m isKindOf: StringMorph) ifTrue: [s := m contents]]. ^ s! Item was changed: + ----- Method: BasicButton>>label: (in category 'label') ----- - ----- Method: BasicButton>>label: (in category 'as yet unclassified') ----- label: aString | oldLabel m | (oldLabel := self findA: StringMorph) ifNotNil: [oldLabel delete]. m := StringMorph contents: aString font: TextStyle defaultFont. self extent: m extent + (self borderWidth + 6). m position: self center - (m extent // 2). self addMorph: m. m lock! Item was changed: + ----- Method: BasicButton>>label:font: (in category 'label') ----- - ----- Method: BasicButton>>label:font: (in category 'as yet unclassified') ----- label: aString font: aFontOrNil | oldLabel m aFont | (oldLabel := self findA: StringMorph) ifNotNil: [oldLabel delete]. aFont := aFontOrNil ifNil: [Preferences standardButtonFont]. m := StringMorph contents: aString font: aFont. self extent: (m width + 6) @ (m height + 6). m position: self center - (m extent // 2). self addMorph: m. m lock ! Item was changed: + ----- Method: BasicButton>>setLabel (in category 'label') ----- - ----- Method: BasicButton>>setLabel (in category 'as yet unclassified') ----- setLabel | newLabel | newLabel := UIManager default request: 'Enter a new label for this button' initialAnswer: self label. newLabel isEmpty ifFalse: [self label: newLabel font: nil]. ! Item was changed: + ----- Method: BookPageSorterMorph>>acceptSort (in category 'buttons') ----- - ----- Method: BookPageSorterMorph>>acceptSort (in category 'as yet unclassified') ----- acceptSort book acceptSortedContentsFrom: pageHolder. self delete. ! Item was changed: + ----- Method: BookPageSorterMorph>>book:morphsToSort: (in category 'initialization') ----- - ----- Method: BookPageSorterMorph>>book:morphsToSort: (in category 'as yet unclassified') ----- book: aBookMorph morphsToSort: morphList | innerBounds scrollPane newHeight | book := aBookMorph. newHeight := self currentWorld height. pageHolder removeAllMorphs. pageHolder addAllMorphs: morphList. pageHolder extent: pageHolder width@pageHolder fullBounds height. innerBounds := Rectangle merging: (morphList collect: [:m | m bounds]). pageHolder extent: innerBounds extent + pageHolder borderWidth + 6. (pageHolder height > newHeight) ifTrue: [ scrollPane := ScrollPane new. self height: newHeight. scrollPane model: pageHolder. scrollPane extent: pageHolder width@(newHeight - aBookMorph submorphs first height - 28). self addMorph: scrollPane inFrontOf: pageHolder. scrollPane scroller addMorph: pageHolder. scrollPane scrollBarOnLeft: false. scrollPane retractable: false. scrollPane hideHScrollBarIndefinitely: true. scrollPane borderWidth: 1; borderColor: Color gray. ]. ! Item was changed: + ----- Method: BookPageSorterMorph>>changeExtent: (in category 'private') ----- - ----- Method: BookPageSorterMorph>>changeExtent: (in category 'as yet unclassified') ----- changeExtent: aPoint self extent: aPoint. pageHolder extent: self extent - self borderWidth! Item was changed: + ----- Method: BookPageSorterMorph>>closeButtonOnly (in category 'private') ----- - ----- Method: BookPageSorterMorph>>closeButtonOnly (in category 'as yet unclassified') ----- closeButtonOnly "Replace my default control panel with one that has only a close button." | b r | self firstSubmorph delete. "remove old control panel" b := SimpleButtonMorph new target: self; borderColor: Color black. r := AlignmentMorph newRow. r color: b color; borderWidth: 0; layoutInset: 0. r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. r wrapCentering: #topLeft. r addMorphBack: (b label: 'Close' translated; actionSelector: #delete). self addMorphFront: r. ! Item was changed: + ----- Method: BookPageSorterMorph>>columnWith: (in category 'private') ----- - ----- Method: BookPageSorterMorph>>columnWith: (in category 'as yet unclassified') ----- columnWith: aMorph ^AlignmentMorph newColumn color: Color transparent; hResizing: #shrinkWrap; vResizing: #shrinkWrap; wrapCentering: #center; cellPositioning: #topCenter; layoutInset: 1; addMorph: aMorph ! Item was changed: + ----- Method: BookPageSorterMorph>>getPartsBinStatus (in category 'buttons') ----- - ----- Method: BookPageSorterMorph>>getPartsBinStatus (in category 'as yet unclassified') ----- getPartsBinStatus ^pageHolder isPartsBin! Item was changed: + ----- Method: BookPageSorterMorph>>pageHolder (in category 'accessing') ----- - ----- Method: BookPageSorterMorph>>pageHolder (in category 'as yet unclassified') ----- pageHolder ^ pageHolder ! Item was changed: + ----- Method: BookPageSorterMorph>>rowWith: (in category 'private') ----- - ----- Method: BookPageSorterMorph>>rowWith: (in category 'as yet unclassified') ----- rowWith: aMorph ^AlignmentMorph newColumn color: Color transparent; hResizing: #shrinkWrap; vResizing: #shrinkWrap; wrapCentering: #center; cellPositioning: #topCenter; layoutInset: 1; addMorph: aMorph ! Item was changed: + ----- Method: BookPageSorterMorph>>togglePartsBinStatus (in category 'buttons') ----- - ----- Method: BookPageSorterMorph>>togglePartsBinStatus (in category 'as yet unclassified') ----- togglePartsBinStatus pageHolder isPartsBin: pageHolder isPartsBin not! Item was changed: + ----- Method: BookPageSorterMorph>>wrapperFor: (in category 'private') ----- - ----- Method: BookPageSorterMorph>>wrapperFor: (in category 'as yet unclassified') ----- wrapperFor: aMorph ^self columnWith: (self rowWith: aMorph) ! Item was changed: + ----- Method: BookPageThumbnailMorph>>bookMorph (in category 'accessing') ----- - ----- Method: BookPageThumbnailMorph>>bookMorph (in category 'as yet unclassified') ----- bookMorph ^bookMorph! Item was changed: + ----- Method: BookPageThumbnailMorph>>computeThumbnail (in category 'private') ----- - ----- Method: BookPageThumbnailMorph>>computeThumbnail (in category 'as yet unclassified') ----- computeThumbnail | f scale | self objectsInMemory. f := page imageForm. scale := (self height / f height). "keep height invariant" "(Sensor shiftPressed) ifTrue: [scale := scale * 1.4]." self form: (f magnify: f boundingBox by: scale@scale smoothing: 2). ! Item was changed: + ----- Method: BookPageThumbnailMorph>>doPageFlip (in category 'private') ----- - ----- Method: BookPageThumbnailMorph>>doPageFlip (in category 'as yet unclassified') ----- doPageFlip "Flip to this page" self objectsInMemory. bookMorph ifNil: [^ self]. bookMorph goToPageMorph: page transitionSpec: (self valueOfProperty: #transitionSpec). (owner isKindOf: PasteUpMorph) ifTrue: [owner cursor: (owner submorphs indexOf: self ifAbsent: [1])]! Item was changed: + ----- Method: BookPageThumbnailMorph>>inBook: (in category 'accessing') ----- - ----- Method: BookPageThumbnailMorph>>inBook: (in category 'as yet unclassified') ----- inBook: book bookMorph := book! Item was changed: + ----- Method: BookPageThumbnailMorph>>makeFlexMorphFor: (in category 'private') ----- - ----- Method: BookPageThumbnailMorph>>makeFlexMorphFor: (in category 'as yet unclassified') ----- makeFlexMorphFor: aHand aHand grabMorph: (FlexMorph new originalMorph: page)! Item was changed: + ----- Method: BookPageThumbnailMorph>>page (in category 'accessing') ----- - ----- Method: BookPageThumbnailMorph>>page (in category 'as yet unclassified') ----- page ^ page ! Item was changed: + ----- Method: BookPageThumbnailMorph>>page: (in category 'accessing') ----- - ----- Method: BookPageThumbnailMorph>>page: (in category 'as yet unclassified') ----- page: aMorph page := aMorph. self computeThumbnail. self setNameTo: aMorph externalName. page fullReleaseCachedState. ! Item was changed: + ----- Method: BookPageThumbnailMorph>>pageMorph:inBook: (in category 'accessing') ----- - ----- Method: BookPageThumbnailMorph>>pageMorph:inBook: (in category 'as yet unclassified') ----- pageMorph: pageMorph inBook: book page := pageMorph. bookMorph := book! Item was changed: + ----- Method: BookPageThumbnailMorph>>pageNumber:inBook: (in category 'accessing') ----- - ----- Method: BookPageThumbnailMorph>>pageNumber:inBook: (in category 'as yet unclassified') ----- pageNumber: n inBook: b pageNumber := n. bookMorph := b! Item was changed: + ----- Method: BookPageThumbnailMorph>>setPageSound: (in category 'menus') ----- - ----- Method: BookPageThumbnailMorph>>setPageSound: (in category 'as yet unclassified') ----- setPageSound: event ^ bookMorph menuPageSoundFor: self event: event! Item was changed: + ----- Method: BookPageThumbnailMorph>>setPageVisual: (in category 'menus') ----- - ----- Method: BookPageThumbnailMorph>>setPageVisual: (in category 'as yet unclassified') ----- setPageVisual: event ^ bookMorph menuPageVisualFor: self event: event! Item was changed: + ----- Method: BookPageThumbnailMorph>>smaller (in category 'initialization') ----- - ----- Method: BookPageThumbnailMorph>>smaller (in category 'as yet unclassified') ----- smaller self form: (self form copy: (0@0 extent: self form extent//2)). ! Item was changed: + ----- Method: BookPageThumbnailMorph>>toggleBookmark (in category 'menus') ----- - ----- Method: BookPageThumbnailMorph>>toggleBookmark (in category 'as yet unclassified') ----- toggleBookmark "Enable or disable sensitivity as a bookmark enabled means that a normal click will cause a pageFlip disabled means this morph can be picked up normally by the hand." flipOnClick := flipOnClick not! Item was changed: + ----- Method: Command class>>cleanUp (in category 'initialize-release') ----- - ----- Method: Command class>>cleanUp (in category 'as yet unclassified') ----- cleanUp MorphExtension allInstancesDo: [ :each | each removeUndoCommands ]! Item was changed: + ----- Method: DSCPostscriptCanvasToDisk class>>morphAsPostscript:rotated:offsetBy: (in category 'drawing') ----- - ----- Method: DSCPostscriptCanvasToDisk class>>morphAsPostscript:rotated:offsetBy: (in category 'testing') ----- morphAsPostscript: aMorph rotated: rotateFlag offsetBy: offset ^self morphAsPostscript: aMorph rotated: rotateFlag offsetBy: offset specs: nil ! Item was changed: + ----- Method: DSCPostscriptCanvasToDisk class>>morphAsPostscript:rotated:offsetBy:specs: (in category 'drawing') ----- - ----- Method: DSCPostscriptCanvasToDisk class>>morphAsPostscript:rotated:offsetBy:specs: (in category 'as yet unclassified') ----- morphAsPostscript: aMorph rotated: rotateFlag offsetBy: offset specs: specsOrNil ^[ (self new morphAsPostscript: aMorph rotated: rotateFlag offsetBy: offset) close ] on: PickAFileToWriteNotification do: [ :ex | | newFileName stream | newFileName := UIManager default saveFilenameRequest: 'Name of file to write:' translated initialAnswer: 'xxx',Time millisecondClockValue printString, self defaultExtension. newFileName isEmptyOrNil ifFalse: [ stream := FileStream fileNamed: newFileName. stream ifNotNil: [ex resume: stream]. ]. ]. ! Item was changed: + ----- Method: DSCPostscriptCanvasToDisk class>>morphAsPostscript:rotated:specs: (in category 'drawing') ----- - ----- Method: DSCPostscriptCanvasToDisk class>>morphAsPostscript:rotated:specs: (in category 'as yet unclassified') ----- morphAsPostscript: aMorph rotated: rotateFlag specs: specsOrNil ^ self morphAsPostscript: aMorph rotated: rotateFlag offsetBy: self baseOffset specs: specsOrNil ! Item was changed: + ----- Method: DSCPostscriptCanvasToDisk>>morphAsPostscript:rotated:offsetBy: (in category 'drawing') ----- - ----- Method: DSCPostscriptCanvasToDisk>>morphAsPostscript:rotated:offsetBy: (in category 'as yet unclassified') ----- morphAsPostscript: aMorph rotated: rotateFlag offsetBy: offset ^self morphAsPostscript: aMorph rotated: rotateFlag offsetBy: offset specs: nil ! Item was changed: + ----- Method: DSCPostscriptCanvasToDisk>>morphAsPostscript:rotated:offsetBy:specs: (in category 'drawing') ----- - ----- Method: DSCPostscriptCanvasToDisk>>morphAsPostscript:rotated:offsetBy:specs: (in category 'as yet unclassified') ----- morphAsPostscript: aMorph rotated: rotateFlag offsetBy: offset specs: specsOrNil self reset. psBounds := offset extent: aMorph bounds extent. topLevelMorph := aMorph. self writeHeaderRotated: rotateFlag. self fullDrawMorph: aMorph. ^ self close! Item was changed: + ----- Method: EmbeddedWorldBorderMorph>>goAppView (in category 'navigation') ----- - ----- Method: EmbeddedWorldBorderMorph>>goAppView (in category 'as yet unclassified') ----- goAppView self worldIEnclose showApplicationView ! Item was changed: + ----- Method: EmbeddedWorldBorderMorph>>goFactoryView (in category 'navigation') ----- - ----- Method: EmbeddedWorldBorderMorph>>goFactoryView (in category 'as yet unclassified') ----- goFactoryView self worldIEnclose showFactoryView ! Item was changed: + ----- Method: EmbeddedWorldBorderMorph>>goFullView (in category 'navigation') ----- - ----- Method: EmbeddedWorldBorderMorph>>goFullView (in category 'as yet unclassified') ----- goFullView self worldIEnclose showFullView ! Item was changed: + ----- Method: EmbeddedWorldBorderMorph>>goNormalProjectEntry (in category 'navigation') ----- - ----- Method: EmbeddedWorldBorderMorph>>goNormalProjectEntry (in category 'as yet unclassified') ----- goNormalProjectEntry | w | w := self worldIEnclose. self delete. w project enter. ! Item was changed: + ----- Method: EmbeddedWorldBorderMorph>>myTransformation (in category 'accessing') ----- - ----- Method: EmbeddedWorldBorderMorph>>myTransformation (in category 'as yet unclassified') ----- myTransformation ^submorphs detect: [ :x | x isKindOf: TransformationMorph] ifNone: [nil] ! Item was changed: + ----- Method: EmbeddedWorldBorderMorph>>myWorldChanged (in category 'layout') ----- - ----- Method: EmbeddedWorldBorderMorph>>myWorldChanged (in category 'as yet unclassified') ----- myWorldChanged | trans | trans := self myTransformation. self changed. self layoutChanged. trans ifNotNil:[ trans extentFromParent: self innerBounds extent. bounds := self bounds topLeft extent: trans extent + (self borderWidth * 2). ]. self changed. ! Item was changed: + ----- Method: EmbeddedWorldBorderMorph>>toggleZoom (in category 'accessing') ----- - ----- Method: EmbeddedWorldBorderMorph>>toggleZoom (in category 'as yet unclassified') ----- toggleZoom self bounds: ( bounds area > (Display boundingBox area * 0.9) ifTrue: [ Display extent // 4 extent: Display extent // 2. ] ifFalse: [ Display boundingBox ] ) ! Item was changed: + ----- Method: EmbeddedWorldBorderMorph>>worldIEnclose (in category 'accessing') ----- - ----- Method: EmbeddedWorldBorderMorph>>worldIEnclose (in category 'as yet unclassified') ----- worldIEnclose ^self myTransformation firstSubmorph "quick hack since this is the only usage pattern at the moment" ! Item was changed: + ----- Method: EnvelopeEditorMorph class>>openOn:title: (in category 'opening') ----- - ----- Method: EnvelopeEditorMorph class>>openOn:title: (in category 'as yet unclassified') ----- openOn: aSound title: aString "EnvelopeEditorMorph openOn: (AbstractSound soundNamed: 'brass1') copy title: 'brass1'" (self basicNew initOnSound: aSound title: aString) openInWorld! Item was changed: + ----- Method: FlapTab class>>givenID:matches: (in category 'testing') ----- - ----- Method: FlapTab class>>givenID:matches: (in category 'as yet unclassified') ----- givenID: aFlapID matches: pureID "eg, FlapTab givenID: 'Stack Tools2' matches: 'Stack Tools' " ^ aFlapID = pureID or: [(aFlapID beginsWith: pureID) and: [(aFlapID copyFrom: pureID size+1 to: aFlapID size) allSatisfy: [:c | c isDigit]]]! Item was changed: + ----- Method: FlapTab>>fitContents (in category 'layout') ----- - ----- Method: FlapTab>>fitContents (in category 'misc') ----- fitContents self isCurrentlyTextual ifFalse: [^ super fitContents]. self ifVertical: [self extent: submorphs first extent + (2 * self borderWidth) + (0 @ 4). submorphs first position: self position + self borderWidth + (1 @ 4)] ifHorizontal: [self extent: submorphs first extent + (2 * self borderWidth) + (8 @ -1). submorphs first position: self position + self borderWidth + (5 @ 1)]! Item was changed: + ----- Method: GeeBookMorph>>geeMail: (in category 'accessing') ----- - ----- Method: GeeBookMorph>>geeMail: (in category 'as yet unclassified') ----- geeMail: aGeeMail geeMail := aGeeMail.! Item was changed: + ----- Method: GeeBookMorph>>geePageRectangles (in category 'ui') ----- - ----- Method: GeeBookMorph>>geePageRectangles (in category 'as yet unclassified') ----- geePageRectangles | pageBounds allPageRects | pageBounds := geeMail topLeft extent: geeMail width @ (geeMail height min: Display height - 50). allPageRects := OrderedCollection new. [pageBounds top <= geeMail bottom] whileTrue: [ allPageRects add: pageBounds. pageBounds := pageBounds translateBy: 0 @ pageBounds height. ]. ^allPageRects ! Item was changed: + ----- Method: GeeBookMorph>>rebuildPages (in category 'ui') ----- - ----- Method: GeeBookMorph>>rebuildPages (in category 'as yet unclassified') ----- rebuildPages pages := self geePageRectangles collect: [ :each | GeeBookPageMorph new disableDragNDrop; geeMail: geeMail geeMailRectangle: each. ]. currentPage delete. currentPage := nil. pages isEmpty ifTrue: [^ self insertPage]. self goToPage: 1. ! Item was changed: + ----- Method: GeeBookPageMorph>>geeMail:geeMailRectangle: (in category 'initialization') ----- - ----- Method: GeeBookPageMorph>>geeMail:geeMailRectangle: (in category 'as yet unclassified') ----- geeMail: aGeeMail geeMailRectangle: aRectangle geeMail := aGeeMail. geeMailRectangle := aRectangle. self extent: aRectangle extent.! Item was changed: + ----- Method: GeeMailMorph>>addGeeMailMenuItemsTo: (in category 'menus') ----- - ----- Method: GeeMailMorph>>addGeeMailMenuItemsTo: (in category 'as yet unclassified') ----- addGeeMailMenuItemsTo: menu - self flag: #convertToBook. "<-- no longer used" menu addUpdating: #showPageBreaksString action: #togglePageBreaks; addUpdating: #keepScrollbarString action: #toggleKeepScrollbar; addLine; add: 'Print...' translated action: #printPSToFile; addLine. thePasteUp allTextPlusMorphs size = 1 ifTrue: [ menu add: 'make 1-column book' translated selector: #makeBookStyle: argument: 1. menu add: 'make 2-column book' translated selector: #makeBookStyle: argument: 2. menu add: 'make 3-column book' translated selector: #makeBookStyle: argument: 3. menu add: 'make 4-column book' translated selector: #makeBookStyle: argument: 4. ] ifFalse: [ menu add: 'make a galley of me' translated action: #makeGalleyStyle. ]. ^menu! Item was changed: + ----- Method: GeeMailMorph>>adjustPasteUpSize (in category 'private') ----- - ----- Method: GeeMailMorph>>adjustPasteUpSize (in category 'as yet unclassified') ----- adjustPasteUpSize | newBottom | thePasteUp ifNil: [^self]. newBottom := thePasteUp bottom max: thePasteUp boundingBoxOfSubmorphs bottom + 20. thePasteUp height: (newBottom - thePasteUp top max: self height). thePasteUp width: (thePasteUp width max: scroller innerBounds width - 5).! Item was changed: + ----- Method: GeeMailMorph>>allTextPlusMorphs (in category 'accessing') ----- - ----- Method: GeeMailMorph>>allTextPlusMorphs (in category 'as yet unclassified') ----- allTextPlusMorphs ^thePasteUp allTextPlusMorphs! Item was removed: - ----- Method: GeeMailMorph>>convertToBook (in category 'as yet unclassified') ----- - convertToBook - - GeeBookMorph new - geeMail: thePasteUp; - rebuildPages; - openInWorld! Item was changed: + ----- Method: GeeMailMorph>>getMenu: (in category 'menus') ----- - ----- Method: GeeMailMorph>>getMenu: (in category 'menu') ----- getMenu: shiftKeyState | menu | - - self flag: #convertToBook. "<-- no longer used" - menu := MenuMorph new defaultTarget: self. self addGeeMailMenuItemsTo: menu. ^menu! Item was changed: + ----- Method: GeeMailMorph>>keepScrollBarAlways (in category 'menus') ----- - ----- Method: GeeMailMorph>>keepScrollBarAlways (in category 'as yet unclassified') ----- keepScrollBarAlways ^self valueOfProperty: #keepScrollBarAlways ifAbsent: [false]! Item was changed: + ----- Method: GeeMailMorph>>keepScrollbarString (in category 'menus') ----- - ----- Method: GeeMailMorph>>keepScrollbarString (in category 'as yet unclassified') ----- keepScrollbarString ^self keepScrollBarAlways ifTrue: ['<on>scrollbar stays up'] ifFalse: ['<off>scrollbar stays up']! Item was changed: + ----- Method: GeeMailMorph>>makeBookStyle: (in category 'menus') ----- - ----- Method: GeeMailMorph>>makeBookStyle: (in category 'as yet unclassified') ----- makeBookStyle: nColumns | all totalWidth second columnWidth currY prev columnHeight currX currColumn pageBreakRectangles r rm columnGap pageGap starter | pageBreakRectangles := OrderedCollection new. all := thePasteUp allTextPlusMorphs. all size = 1 ifFalse: [^self]. Cursor wait show. starter := prev := all first. totalWidth := self width - 16. columnGap := 32. pageGap := 16. columnWidth := totalWidth - (columnGap * (nColumns - 1)) // nColumns. columnHeight := self height - 12. currY := 4. currX := 4. currColumn := 1. prev position: currX@currY; width: columnWidth. [ second := prev makeSuccessorMorph. thePasteUp addMorphBack: second. prev setProperty: #autoFitContents toValue: false; height: columnHeight. (currColumn := currColumn + 1) <= nColumns ifTrue: [ currX := currX + columnWidth + columnGap. ] ifFalse: [ r := 4@(prev bottom + 4) corner: (self right - 4 @ (prev bottom + pageGap - 4)). rm := RectangleMorph new bounds: r; color: (Color gray alpha: 0.3); borderWidth: 0. pageBreakRectangles add: rm beSticky. thePasteUp addMorphBack: rm. currColumn := 1. currX := 4. currY := prev bottom + pageGap. ]. second autoFit: true; position: currX@currY; width: columnWidth. prev recomposeChain. "was commented" prev := second. prev height > columnHeight ] whileTrue. prev autoFit: true. thePasteUp height: (prev bottom + 20 - self top). self layoutChanged. self setProperty: #pageBreakRectangles toValue: pageBreakRectangles. thePasteUp allTextPlusMorphs do: [ :each | each repositionAnchoredMorphs ]. Cursor normal show. ! Item was changed: + ----- Method: GeeMailMorph>>makeGalleyStyle (in category 'menus') ----- - ----- Method: GeeMailMorph>>makeGalleyStyle (in category 'as yet unclassified') ----- makeGalleyStyle | all first theRest | (self valueOfProperty: #pageBreakRectangles ifAbsent: [#()]) do: [ :each | each delete ]. self removeProperty: #pageBreakRectangles. all := thePasteUp allTextPlusMorphs. first := all select: [ :x | x predecessor isNil]. first size = 1 ifFalse: [^self]. Cursor wait show. first := first first. theRest := all reject: [ :x | x predecessor isNil]. theRest do: [ :each | each delete]. first autoFit: true. first width: self width - 8. first recomposeChain. first repositionAnchoredMorphs. Cursor normal show. ! Item was changed: + ----- Method: GeeMailMorph>>mouseUp:inMorph: (in category 'event handling') ----- - ----- Method: GeeMailMorph>>mouseUp:inMorph: (in category 'as yet unclassified') ----- mouseUp: evt inMorph: aMorph evt hand grabMorph: aMorph "old instances may have a handler we no longer use"! Item was changed: + ----- Method: GeeMailMorph>>pageRectanglesForPrinting (in category 'printing') ----- - ----- Method: GeeMailMorph>>pageRectanglesForPrinting (in category 'as yet unclassified') ----- pageRectanglesForPrinting | pageBreaks pageRects prevBottom | pageBreaks := self valueOfProperty: #pageBreakRectangles ifAbsent: [^nil]. prevBottom := 0. pageRects := pageBreaks collect: [ :each | | r | r := 0@prevBottom corner: self width @ each top. prevBottom := each bottom. r ]. pageRects add: (0@prevBottom corner: self width @ thePasteUp bottom). ^pageRects! Item was changed: + ----- Method: GeeMailMorph>>scrollSelectionIntoView:alignTop:inTextMorph: (in category 'scrolling') ----- - ----- Method: GeeMailMorph>>scrollSelectionIntoView:alignTop:inTextMorph: (in category 'as yet unclassified') ----- scrollSelectionIntoView: event alignTop: alignTop inTextMorph: tm "Scroll my text into view if necessary and return true, else return false" | selRects delta selRect rectToTest transform cpHere | selRects := tm paragraph selectionRects. selRects isEmpty ifTrue: [^ false]. rectToTest := selRects first merge: selRects last. transform := scroller transformFrom: self. (event notNil and: [event isMouse and: [event anyButtonPressed]]) ifTrue: "Check for autoscroll" [cpHere := transform localPointToGlobal: event cursorPoint. cpHere y <= self top ifTrue: [rectToTest := selRects first topLeft extent: 2@2] ifFalse: [cpHere y >= self bottom ifTrue: [rectToTest := selRects last bottomRight extent: 2@2] ifFalse: [^ false]]]. selRect := transform localBoundsToGlobal: rectToTest. selRect height > bounds height ifTrue: [^ false]. "Would not fit, even if we tried to scroll" alignTop ifTrue: [ self scrollBy: 0@(bounds top - selRect top). ^ true ]. selRect bottom > bounds bottom ifTrue: [ self scrollBy: 0@(bounds bottom - selRect bottom - 30). ^ true ]. (delta := selRect amountToTranslateWithin: self bounds) y ~= 0 ifTrue: [ "Scroll end of selection into view if necessary" self scrollBy: 0@delta y. ^ true]. ^ false! Item was changed: + ----- Method: GeeMailMorph>>scrollToPage: (in category 'scrolling') ----- - ----- Method: GeeMailMorph>>scrollToPage: (in category 'as yet unclassified') ----- scrollToPage: pageNumber | rects oneRect | rects := self valueOfProperty: #pageBreakRectangles ifAbsent: [#()]. oneRect := rects at: pageNumber - 1 ifAbsent: [0@0 extent: 0@0]. self scrollToYAbsolute: oneRect bottom. ! Item was changed: + ----- Method: GeeMailMorph>>scrollToYAbsolute: (in category 'scrolling') ----- - ----- Method: GeeMailMorph>>scrollToYAbsolute: (in category 'as yet unclassified') ----- scrollToYAbsolute: yValue | transform transformedPoint | transform := scroller transformFrom: self. transformedPoint := transform localPointToGlobal: 0@yValue. self scrollBy: 0@(bounds top - transformedPoint y). ! Item was changed: + ----- Method: GeeMailMorph>>showPageBreaksString (in category 'menus') ----- - ----- Method: GeeMailMorph>>showPageBreaksString (in category 'as yet unclassified') ----- showPageBreaksString ^(thePasteUp ifNil: [^'???']) showPageBreaksString! Item was changed: + ----- Method: GeeMailMorph>>toggleKeepScrollbar (in category 'menus') ----- - ----- Method: GeeMailMorph>>toggleKeepScrollbar (in category 'as yet unclassified') ----- toggleKeepScrollbar self setProperty: #keepScrollBarAlways toValue: self keepScrollBarAlways not! Item was changed: + ----- Method: GeeMailMorph>>togglePageBreaks (in category 'menus') ----- - ----- Method: GeeMailMorph>>togglePageBreaks (in category 'as yet unclassified') ----- togglePageBreaks (thePasteUp ifNil: [^self]) togglePageBreaks! Item was changed: + ----- Method: GeeMailMorph>>wantsSlot (in category 'accessing') ----- - ----- Method: GeeMailMorph>>wantsSlot (in category 'access') ----- wantsSlot ^false! Item was changed: + ----- Method: GeePrinter>>allPages (in category 'private - postscript canvases') ----- - ----- Method: GeePrinter>>allPages (in category 'as yet unclassified') ----- allPages | pageNumber allPages maxPages | maxPages := 9999. pageNumber := 0. allPages := self pageRectangles collect: [ :rect | pageNumber := pageNumber + 1. (self as: GeePrinterPage) pageNumber: pageNumber bounds: rect ]. allPages size > maxPages ifTrue: [allPages := allPages first: maxPages]. allPages do: [ :each | each totalPages: allPages size]. ^allPages ! Item was changed: + ----- Method: GeePrinter>>bounds (in category 'geometry') ----- - ----- Method: GeePrinter>>bounds (in category 'as yet unclassified') ----- bounds ^computedBounds ifNil: [computedBounds := self computeBounds]! Item was changed: + ----- Method: GeePrinter>>computeBounds (in category 'geometry') ----- - ----- Method: GeePrinter>>computeBounds (in category 'as yet unclassified') ----- computeBounds | w ratio | w := pasteUp width. self printSpecs scaleToFitPage ifTrue: [ ^0@0 extent: w@(w * self hOverW) rounded. ]. ratio := 8.5 @ 11. self printSpecs landscapeFlag ifTrue: [ ratio := ratio transposed ]. ^0@0 extent: (ratio * 72) rounded! Item was changed: + ----- Method: GeePrinter>>doPages (in category 'postscript canvases') ----- - ----- Method: GeePrinter>>doPages (in category 'Postscript Canvases') ----- doPages | dialog | (dialog := GeePrinterDialogMorph new) printSpecs: self printSpecs printBlock: [ :preview :specs | preview ifTrue: [self doPrintPreview] ifFalse: [self doPrintToPrinter] ]; fullBounds; position: Display extent - dialog extent // 2; openInWorld ! Item was changed: + ----- Method: GeePrinter>>doPrintPreview (in category 'private - postscript canvases') ----- - ----- Method: GeePrinter>>doPrintPreview (in category 'as yet unclassified') ----- doPrintPreview | pageDisplay sz | sz := (85 @ 110) * 3. self printSpecs landscapeFlag ifTrue: [ sz := sz transposed ]. pageDisplay := BookMorph new color: Color paleYellow; borderWidth: 1. self allPages withIndexDo: [ :each :index | | pic align newPage subBounds | pic := ImageMorph new image: (each pageThumbnailOfSize: sz). align := AlignmentMorph newColumn addMorph: pic; borderWidth: 1; layoutInset: 0; borderColor: Color blue. newPage := pageDisplay insertPageLabel: 'Page ',index printString morphs: {align}. subBounds := newPage boundingBoxOfSubmorphs. newPage extent: subBounds corner - newPage topLeft + ((subBounds left - newPage left)@0). ]. pageDisplay goToPage: 1; deletePageBasic; position: Display extent - pageDisplay extent // 2; openInWorld. ! Item was changed: + ----- Method: GeePrinter>>doPrintToPrinter (in category 'postscript canvases') ----- - ----- Method: GeePrinter>>doPrintToPrinter (in category 'Postscript Canvases') ----- doPrintToPrinter "fileName := ('gee.',Time millisecondClockValue printString,'.eps') asFileName." self pageRectangles. "ensure bounds computed" DSCPostscriptCanvasToDisk morphAsPostscript: self rotated: self printSpecs landscapeFlag specs: self printSpecs ! Item was changed: + ----- Method: GeePrinter>>drawOn: (in category 'drawing') ----- - ----- Method: GeePrinter>>drawOn: (in category 'as yet unclassified') ----- drawOn: aCanvas pasteUp drawOn: aCanvas ! Item was changed: + ----- Method: GeePrinter>>fullBounds (in category 'layout') ----- - ----- Method: GeePrinter>>fullBounds (in category 'as yet unclassified') ----- fullBounds ^self bounds! Item was changed: + ----- Method: GeePrinter>>fullDrawOn: (in category 'drawing') ----- - ----- Method: GeePrinter>>fullDrawOn: (in category 'as yet unclassified') ----- fullDrawOn: aCanvas pasteUp fullDrawOn: aCanvas ! Item was changed: + ----- Method: GeePrinter>>fullDrawPostscriptOn: (in category 'postscript canvases') ----- - ----- Method: GeePrinter>>fullDrawPostscriptOn: (in category 'Postscript Canvases') ----- fullDrawPostscriptOn: aCanvas aCanvas drawPages: self allPages. ! Item was changed: + ----- Method: GeePrinter>>geeMail: (in category 'accessing') ----- - ----- Method: GeePrinter>>geeMail: (in category 'as yet unclassified') ----- geeMail: aGeeMail geeMail := aGeeMail! Item was changed: + ----- Method: GeePrinter>>hOverW (in category 'private - postscript canvases') ----- - ----- Method: GeePrinter>>hOverW (in category 'as yet unclassified') ----- hOverW ^self printSpecs landscapeFlag ifTrue: [ 8.5 / 11.0 ] ifFalse: [ 11.0 / 8.5 ]. ! Item was changed: + ----- Method: GeePrinter>>pageRectangles (in category 'private - postscript canvases') ----- - ----- Method: GeePrinter>>pageRectangles (in category 'as yet unclassified') ----- pageRectangles | pageBounds allPageRects maxExtent | geeMail ifNotNil: [ allPageRects := geeMail pageRectanglesForPrinting. allPageRects ifNotNil: [ maxExtent := allPageRects inject: 0@0 into: [ :max :each | max max: each extent ]. computedBounds := 0@0 extent: maxExtent. ^allPageRects ]. ]. pageBounds := self bounds. allPageRects := OrderedCollection new. [pageBounds top <= pasteUp bottom] whileTrue: [ allPageRects add: pageBounds. pageBounds := pageBounds translateBy: 0 @ pageBounds height. ]. ^allPageRects ! Item was changed: + ----- Method: GeePrinter>>pagesHandledAutomatically (in category 'printing') ----- - ----- Method: GeePrinter>>pagesHandledAutomatically (in category 'as yet unclassified') ----- pagesHandledAutomatically ^true! Item was changed: + ----- Method: GeePrinter>>pasteUp: (in category 'accessing') ----- - ----- Method: GeePrinter>>pasteUp: (in category 'as yet unclassified') ----- pasteUp: x pasteUp := x.! Item was changed: + ----- Method: GeePrinter>>printSpecs (in category 'accessing') ----- - ----- Method: GeePrinter>>printSpecs (in category 'as yet unclassified') ----- printSpecs ^printSpecs ifNil: [printSpecs := PrintSpecifications defaultSpecs]. ! Item was changed: + ----- Method: GeePrinter>>printSpecs: (in category 'accessing') ----- - ----- Method: GeePrinter>>printSpecs: (in category 'as yet unclassified') ----- printSpecs: aPrintSpecification printSpecs := aPrintSpecification! Item was changed: + ----- Method: GeePrinter>>wantsRoundedCorners (in category 'rounding') ----- - ----- Method: GeePrinter>>wantsRoundedCorners (in category 'as yet unclassified') ----- wantsRoundedCorners ^false! Item was changed: + ----- Method: GeePrinterDialogMorph>>buttonColor (in category 'user interface - constants') ----- - ----- Method: GeePrinterDialogMorph>>buttonColor (in category 'as yet unclassified') ----- buttonColor ^color darker! Item was changed: + ----- Method: GeePrinterDialogMorph>>buttonNamed:action:color:help: (in category 'private') ----- - ----- Method: GeePrinterDialogMorph>>buttonNamed:action:color:help: (in category 'as yet unclassified') ----- buttonNamed: aString action: aSymbol color: aColor help: helpString | f col | f := SimpleButtonMorph new target: self; label: aString; color: aColor; borderColor: aColor muchDarker; actionSelector: aSymbol; setBalloonText: helpString. col := self inAColumn: {f}. col hResizing: #shrinkWrap. ^ col! Item was changed: + ----- Method: GeePrinterDialogMorph>>cancelButton (in category 'user interface') ----- - ----- Method: GeePrinterDialogMorph>>cancelButton (in category 'as yet unclassified') ----- cancelButton ^ self buttonNamed: 'Cancel' action: #doCancel color: Color lightRed help: 'Cancel this printing operation.'! Item was changed: + ----- Method: GeePrinterDialogMorph>>doCancel (in category 'user interface') ----- - ----- Method: GeePrinterDialogMorph>>doCancel (in category 'as yet unclassified') ----- doCancel self delete! Item was changed: + ----- Method: GeePrinterDialogMorph>>doPreview (in category 'user interface') ----- - ----- Method: GeePrinterDialogMorph>>doPreview (in category 'as yet unclassified') ----- doPreview self delete. printBlock value: true value: printSpecs.! Item was changed: + ----- Method: GeePrinterDialogMorph>>doPrint (in category 'user interface') ----- - ----- Method: GeePrinterDialogMorph>>doPrint (in category 'as yet unclassified') ----- doPrint self delete. printBlock value: false value: printSpecs.! Item was changed: + ----- Method: GeePrinterDialogMorph>>getChoice: (in category 'user interface') ----- - ----- Method: GeePrinterDialogMorph>>getChoice: (in category 'as yet unclassified') ----- getChoice: aSymbol aSymbol == #landscapeFlag ifTrue: [^printSpecs landscapeFlag]. aSymbol == #drawAsBitmapFlag ifTrue: [^printSpecs drawAsBitmapFlag]. aSymbol == #scaleToFitPage ifTrue: [^printSpecs scaleToFitPage]. ! Item was changed: + ----- Method: GeePrinterDialogMorph>>previewButton (in category 'user interface') ----- - ----- Method: GeePrinterDialogMorph>>previewButton (in category 'as yet unclassified') ----- previewButton ^self buttonNamed: 'Preview' action: #doPreview color: self buttonColor help: 'Show a preview of the pages that will be printed on the screen.'! Item was changed: + ----- Method: GeePrinterDialogMorph>>printButton (in category 'user interface') ----- - ----- Method: GeePrinterDialogMorph>>printButton (in category 'as yet unclassified') ----- printButton ^self buttonNamed: 'Print' action: #doPrint color: self buttonColor help: 'Print me (a PostScript file will be created)'! Item was changed: + ----- Method: GeePrinterDialogMorph>>printSpecs:printBlock: (in category 'accessing') ----- - ----- Method: GeePrinterDialogMorph>>printSpecs:printBlock: (in category 'as yet unclassified') ----- printSpecs: aPrintSpecification printBlock: aTwoArgBlock printSpecs := aPrintSpecification. printBlock := aTwoArgBlock.! Item was changed: + ----- Method: GeePrinterDialogMorph>>rebuild (in category 'private') ----- - ----- Method: GeePrinterDialogMorph>>rebuild (in category 'as yet unclassified') ----- rebuild self removeAllMorphs. self addARow: { (StringMorph contents: 'PostScript Printing Options') lock. }. self addARow: { self simpleToggleButtonFor: self attribute: #landscapeFlag help: 'Print in landscape mode'. (StringMorph contents: ' Landscape') lock. }. self addARow: { self simpleToggleButtonFor: self attribute: #drawAsBitmapFlag help: 'Print as a bitmap'. (StringMorph contents: ' Bitmap') lock. }. self addARow: { self simpleToggleButtonFor: self attribute: #scaleToFitPage help: 'Scale printing to fill page'. (StringMorph contents: ' Scale to fit') lock. }. self addARow: { self printButton. self previewButton. self cancelButton. }.! Item was changed: + ----- Method: GeePrinterDialogMorph>>toggleChoice: (in category 'user interface') ----- - ----- Method: GeePrinterDialogMorph>>toggleChoice: (in category 'as yet unclassified') ----- toggleChoice: aSymbol aSymbol == #landscapeFlag ifTrue: [ printSpecs landscapeFlag: printSpecs landscapeFlag not ]. aSymbol == #drawAsBitmapFlag ifTrue: [ printSpecs drawAsBitmapFlag: printSpecs drawAsBitmapFlag not ]. aSymbol == #scaleToFitPage ifTrue: [ printSpecs scaleToFitPage: printSpecs scaleToFitPage not ]. ! Item was changed: + ----- Method: GeePrinterPage>>fullDrawPostscriptOn: (in category 'postscript canvases') ----- - ----- Method: GeePrinterPage>>fullDrawPostscriptOn: (in category 'Postscript Canvases') ----- fullDrawPostscriptOn: aCanvas | s | s := TextMorph new beAllFont: (TextStyle default fontOfSize: 30); contentsAsIs: ' Drawing page ',pageNumber printString,' of ',totalPages printString,' '. s layoutChanged; fullBounds. s := AlignmentMorph newRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; addMorph: s; color: Color yellow. s position: Display center - (s width // 2 @ 0). Project current world addMorphFront: s; displayWorld. printSpecs drawAsBitmapFlag ifTrue: [ aCanvas paintImage: self pageAsForm at: 0@0 ] ifFalse: [ aCanvas translateTo: bounds origin negated clippingTo: (0@0 extent: bounds extent) during: [ :c | pasteUp fullDrawForPrintingOn: c ]. ]. s delete. ! Item was changed: + ----- Method: GeePrinterPage>>pageAsForm (in category 'private - postscript canvases') ----- - ----- Method: GeePrinterPage>>pageAsForm (in category 'as yet unclassified') ----- pageAsForm | f canvas | f := Form extent: bounds extent depth: 16. canvas := f getCanvas. canvas fillColor: pasteUp color. canvas translateTo: bounds origin negated clippingTo: f boundingBox during: [ :c | pasteUp fullDrawForPrintingOn: c ]. ^f ! Item was changed: + ----- Method: GeePrinterPage>>pageNumber:bounds: (in category 'private - accessing') ----- - ----- Method: GeePrinterPage>>pageNumber:bounds: (in category 'as yet unclassified') ----- pageNumber: anInteger bounds: aRect pageNumber := anInteger. bounds := aRect.! Item was changed: + ----- Method: GeePrinterPage>>pageThumbnailOfSize: (in category 'private - postscript canvases') ----- - ----- Method: GeePrinterPage>>pageThumbnailOfSize: (in category 'as yet unclassified') ----- pageThumbnailOfSize: aPoint ^self pageAsForm scaledToSize: aPoint ! Item was changed: + ----- Method: GeePrinterPage>>totalPages: (in category 'private - accessing') ----- - ----- Method: GeePrinterPage>>totalPages: (in category 'as yet unclassified') ----- totalPages: x totalPages := x! Item was changed: + ----- Method: GradientFillMorph>>gradientFillColor: (in category 'accessing') ----- - ----- Method: GradientFillMorph>>gradientFillColor: (in category 'as yet unclassified') ----- gradientFillColor: aColor fillColor2 := aColor. self changed. ! Item was changed: + ----- Method: GradientFillMorph>>setGradientColor: (in category 'menu') ----- - ----- Method: GradientFillMorph>>setGradientColor: (in category 'as yet unclassified') ----- setGradientColor: evt self changeColorTarget: self selector: #gradientFillColor: originalColor: fillColor2 hand: evt hand! Item was changed: + ----- Method: LedTimerMorph>>updateTime (in category 'stepping and presenter') ----- - ----- Method: LedTimerMorph>>updateTime (in category 'stepping') ----- updateTime self value: Time totalSeconds - startSeconds. self changed! Item was changed: + ----- Method: MorphObjectOut>>doesNotUnderstand: (in category 'error handling') ----- - ----- Method: MorphObjectOut>>doesNotUnderstand: (in category 'as yet unclassified') ----- doesNotUnderstand: aMessage "Bring in the object, install, then resend aMessage" | aMorph myUrl oldFlag response | "Transcript show: thisContext sender selector; cr." "useful for debugging" oldFlag := recursionFlag. recursionFlag := true. myUrl := url. "can't use inst vars after become" "fetch the object" aMorph := self xxxFetch. "watch out for the become!!" "Now we ARE a MORPH" oldFlag == true ifTrue: [ response := UIManager default chooseFrom: #('proceed normally' 'debug') title: 'Object being fetched for a second time. Should not happen, and needs to be fixed later.'. response = 2 ifTrue: [self halt]]. "We are already the new object" aMorph setProperty: #SqueakPage toValue: (SqueakPageCache pageCache at: myUrl). "Can't be a super message, since this is the first message sent to this object" ^ aMorph perform: aMessage selector withArguments: aMessage arguments ! Item was changed: + ----- Method: MorphObjectOut>>fullReleaseCachedState (in category 'caching') ----- - ----- Method: MorphObjectOut>>fullReleaseCachedState (in category 'as yet unclassified') ----- fullReleaseCachedState "do nothing, especially don't bring in my object!!"! Item was changed: + ----- Method: MorphObjectOut>>smallThumbnailForPageSorter (in category 'misc') ----- - ----- Method: MorphObjectOut>>smallThumbnailForPageSorter (in category 'as yet unclassified') ----- smallThumbnailForPageSorter ^ self sqkPage thumbnail! Item was changed: + ----- Method: MorphObjectOut>>thumbnailForPageSorter (in category 'misc') ----- - ----- Method: MorphObjectOut>>thumbnailForPageSorter (in category 'as yet unclassified') ----- thumbnailForPageSorter ^ self sqkPage thumbnail! Item was changed: + ----- Method: MorphThumbnail>>computeThumbnail (in category 'private') ----- - ----- Method: MorphThumbnail>>computeThumbnail (in category 'as yet unclassified') ----- computeThumbnail "Assumption on entry: The receiver's width represents the maximum width allowable. The receiver's height represents the exact height desired." | f scaleX scaleY | f := morphRepresented imageForm. morphRepresented fullReleaseCachedState. scaleY := self height / f height. "keep height invariant" scaleX := ((morphRepresented width * scaleY) <= self width) ifTrue: [scaleY] "the usual case; same scale factor, to preserve aspect ratio" ifFalse: [self width / f width]. self form: (f magnify: f boundingBox by: (scaleX @ scaleY) smoothing: 2). self extent: originalForm extent! Item was changed: + ----- Method: MorphThumbnail>>grabOriginal (in category 'menus') ----- - ----- Method: MorphThumbnail>>grabOriginal (in category 'as yet unclassified') ----- grabOriginal self primaryHand attachMorph: morphRepresented! Item was changed: + ----- Method: MorphThumbnail>>morphRepresented: (in category 'accessing') ----- - ----- Method: MorphThumbnail>>morphRepresented: (in category 'as yet unclassified') ----- morphRepresented: aMorph morphRepresented := aMorph. self computeThumbnail. ! Item was changed: + ----- Method: MorphThumbnail>>revealOriginal (in category 'menus') ----- - ----- Method: MorphThumbnail>>revealOriginal (in category 'as yet unclassified') ----- revealOriginal ((owner isKindOf: PasteUpMorph) and: [owner alwaysShowThumbnail]) ifTrue: [^Beeper beep]. morphRepresented owner isNil ifTrue: [^owner replaceSubmorph: self by: morphRepresented]. Beeper beep! Item was changed: + ----- Method: MorphThumbnail>>smaller (in category 'initialization') ----- - ----- Method: MorphThumbnail>>smaller (in category 'as yet unclassified') ----- smaller self form: (self form copy: (0@0 extent: self form extent // 2))! Item was changed: + ----- Method: ObjectOut>>doesNotUnderstand: (in category 'error handling') ----- - ----- Method: ObjectOut>>doesNotUnderstand: (in category 'fetch from disk') ----- doesNotUnderstand: aMessage "Bring in the object, install, then resend aMessage" | realObject oldFlag response | oldFlag := recursionFlag. recursionFlag := true. "fetch the object" realObject := self xxxFetch. "watch out for the become!!" "Now we ARE the realObject" oldFlag == true ifTrue: [ response := (UIManager default chooseFrom: #('proceed normally' 'debug') title: 'Object being fetched for a second time. Should not happen, and needs to be fixed later.'). response = 2 ifTrue: [self halt]]. "We are already the new object" "Can't be a super message, since this is the first message sent to this object" ^ realObject perform: aMessage selector withArguments: aMessage arguments! Item was changed: + ----- Method: PostscriptCanvas class>>morphAsPostscript: (in category 'drawing') ----- - ----- Method: PostscriptCanvas class>>morphAsPostscript: (in category 'testing') ----- morphAsPostscript:aMorph ^self morphAsPostscript:aMorph rotated:false offsetBy:self baseOffset. ! Item was changed: + ----- Method: PostscriptCanvas class>>morphAsPostscript:rotated: (in category 'drawing') ----- - ----- Method: PostscriptCanvas class>>morphAsPostscript:rotated: (in category 'testing') ----- morphAsPostscript: aMorph rotated: rotateFlag ^ self morphAsPostscript: aMorph rotated: rotateFlag offsetBy: self baseOffset. ! Item was changed: + ----- Method: PostscriptCanvas class>>morphAsPostscript:rotated:offsetBy: (in category 'drawing') ----- - ----- Method: PostscriptCanvas class>>morphAsPostscript:rotated:offsetBy: (in category 'testing') ----- morphAsPostscript:aMorph rotated:rotateFlag offsetBy:offset | psCanvas | psCanvas := self new. psCanvas reset. psCanvas bounds: (0@0 extent: (aMorph bounds extent + (2 * offset))). psCanvas topLevelMorph:aMorph. psCanvas resetContentRotated: rotateFlag. psCanvas fullDrawMorph: aMorph . ^psCanvas contents. ! Item was changed: + ----- Method: PostscriptCharacterScanner class>>scannerWithCanvas:paragraph:bounds: (in category 'instance creation') ----- - ----- Method: PostscriptCharacterScanner class>>scannerWithCanvas:paragraph:bounds: (in category 'as yet unclassified') ----- scannerWithCanvas:aCanvas paragraph:aParagraph bounds:newBounds ^self new canvas:aCanvas; paragraph:aParagraph; bounds:newBounds. ! Item was changed: + ----- Method: PostscriptDummyWarp class>>canvas: (in category 'instance creation') ----- - ----- Method: PostscriptDummyWarp class>>canvas: (in category 'as yet unclassified') ----- canvas:aCanvas ^self new canvas:aCanvas.! Item was changed: + ----- Method: PrintSpecifications class>>defaultSpecs (in category 'accessing') ----- - ----- Method: PrintSpecifications class>>defaultSpecs (in category 'as yet unclassified') ----- defaultSpecs DefaultSpecs ifNil: [DefaultSpecs := self new]. ^DefaultSpecs copy! Item was changed: + ----- Method: PrintSpecifications class>>defaultSpecs: (in category 'accessing') ----- - ----- Method: PrintSpecifications class>>defaultSpecs: (in category 'as yet unclassified') ----- defaultSpecs: aPrintSpecification DefaultSpecs := aPrintSpecification! Item was changed: + ----- Method: PrintSpecifications>>drawAsBitmapFlag (in category 'acccessing') ----- - ----- Method: PrintSpecifications>>drawAsBitmapFlag (in category 'as yet unclassified') ----- drawAsBitmapFlag ^drawAsBitmapFlag ifNil: [false]! Item was changed: + ----- Method: PrintSpecifications>>drawAsBitmapFlag: (in category 'acccessing') ----- - ----- Method: PrintSpecifications>>drawAsBitmapFlag: (in category 'as yet unclassified') ----- drawAsBitmapFlag: aBoolean drawAsBitmapFlag := aBoolean! Item was changed: + ----- Method: PrintSpecifications>>initialize (in category 'initialize-release') ----- - ----- Method: PrintSpecifications>>initialize (in category 'as yet unclassified') ----- initialize landscapeFlag := false. scaleToFitPage := false. drawAsBitmapFlag := false. ! Item was changed: + ----- Method: PrintSpecifications>>landscapeFlag (in category 'acccessing') ----- - ----- Method: PrintSpecifications>>landscapeFlag (in category 'as yet unclassified') ----- landscapeFlag ^landscapeFlag ifNil: [false]! Item was changed: + ----- Method: PrintSpecifications>>landscapeFlag: (in category 'acccessing') ----- - ----- Method: PrintSpecifications>>landscapeFlag: (in category 'as yet unclassified') ----- landscapeFlag: aBoolean landscapeFlag := aBoolean! Item was changed: + ----- Method: PrintSpecifications>>scaleToFitPage (in category 'acccessing') ----- - ----- Method: PrintSpecifications>>scaleToFitPage (in category 'as yet unclassified') ----- scaleToFitPage ^scaleToFitPage ifNil: [false]! Item was changed: + ----- Method: PrintSpecifications>>scaleToFitPage: (in category 'acccessing') ----- - ----- Method: PrintSpecifications>>scaleToFitPage: (in category 'as yet unclassified') ----- scaleToFitPage: aBoolean scaleToFitPage := aBoolean! Item was changed: + ----- Method: ProjectNavigationMorph class>>preferredNavigator (in category 'navigation') ----- - ----- Method: ProjectNavigationMorph class>>preferredNavigator (in category 'as yet unclassified') ----- preferredNavigator "Preferences eToyFriendly ifTrue: [^KidNavigationMorph]." ^ProjectNavigationMorph! Item was changed: + ----- Method: ProjectNavigationMorph>>addButtons (in category 'buttons') ----- - ----- Method: ProjectNavigationMorph>>addButtons (in category 'as yet unclassified') ----- addButtons self orientedVertically ifTrue: [ self addAColumn: ( self makeTheButtons collect: [ :x | self inAColumn: {x}] ) ] ifFalse: [ self addARow: ( self makeTheButtons collect: [ :x | self inAColumn: {x}] ) ]. ! Item was changed: + ----- Method: ProjectNavigationMorph>>amountToShowWhenSmall (in category 'private - ui') ----- - ----- Method: ProjectNavigationMorph>>amountToShowWhenSmall (in category 'as yet unclassified') ----- amountToShowWhenSmall ^7 "if no part of the buttons is visible, we chew up fewer cycles"! Item was changed: + ----- Method: ProjectNavigationMorph>>checkForRebuild (in category 'private') ----- - ----- Method: ProjectNavigationMorph>>checkForRebuild (in category 'as yet unclassified') ----- checkForRebuild | lastScreenMode flapsSuppressed | lastScreenMode := DisplayScreen displayIsFullScreen. flapsSuppressed := Project current flapsSuppressed. ((self valueOfProperty: #currentNavigatorVersion) = self currentNavigatorVersion and: [lastScreenMode = self inFullScreenMode and: [flapsSuppressed = self inFlapsSuppressedMode and: [(self valueOfProperty: #includeSoundControlInNavigator) = Preferences includeSoundControlInNavigator]]]) ifFalse: [ self setProperty: #includeSoundControlInNavigator toValue: Preferences includeSoundControlInNavigator. self setProperty: #flapsSuppressedMode toValue: flapsSuppressed. self setProperty: #showingFullScreenMode toValue: lastScreenMode. self setProperty: #currentNavigatorVersion toValue: self currentNavigatorVersion. self removeAllMorphs. self addButtons. ]. ! Item was changed: + ----- Method: ProjectNavigationMorph>>colorForButtons (in category 'buttons') ----- - ----- Method: ProjectNavigationMorph>>colorForButtons (in category 'as yet unclassified') ----- colorForButtons ^color darker! Item was changed: + ----- Method: ProjectNavigationMorph>>currentNavigatorVersion (in category 'private') ----- - ----- Method: ProjectNavigationMorph>>currentNavigatorVersion (in category 'as yet unclassified') ----- currentNavigatorVersion "Answer the current navigator version." ^ 31 "since these guys get saved, we fix them up if they are older versions"! Item was changed: + ----- Method: ProjectNavigationMorph>>fontForButtons (in category 'buttons') ----- - ----- Method: ProjectNavigationMorph>>fontForButtons (in category 'as yet unclassified') ----- fontForButtons ^ Preferences standardButtonFont! Item was changed: + ----- Method: ProjectNavigationMorph>>inFlapsSuppressedMode (in category 'testing') ----- - ----- Method: ProjectNavigationMorph>>inFlapsSuppressedMode (in category 'as yet unclassified') ----- inFlapsSuppressedMode ^(self valueOfProperty: #flapsSuppressedMode) == true! Item was changed: + ----- Method: ProjectNavigationMorph>>inFullScreenMode (in category 'testing') ----- - ----- Method: ProjectNavigationMorph>>inFullScreenMode (in category 'as yet unclassified') ----- inFullScreenMode ^(self valueOfProperty: #showingFullScreenMode) == true! Item was changed: + ----- Method: ProjectNavigationMorph>>makeButton:balloonText:for: (in category 'buttons') ----- - ----- Method: ProjectNavigationMorph>>makeButton:balloonText:for: (in category 'as yet unclassified') ----- makeButton: aString balloonText: anotherString for: aSymbol ^ SimpleButtonDelayedMenuMorph new target: self; borderStyle: BorderStyle raised; color: self colorForButtons; label: aString font: self fontForButtons; setBalloonText: anotherString; actionSelector: aSymbol! Item was changed: + ----- Method: ProjectNavigationMorph>>makeUpdatingButtonWithBalloonText:actionSelector:wordingSelector: (in category 'buttons') ----- - ----- Method: ProjectNavigationMorph>>makeUpdatingButtonWithBalloonText:actionSelector:wordingSelector: (in category 'as yet unclassified') ----- makeUpdatingButtonWithBalloonText: balloonString actionSelector: actionSymbol wordingSelector: wordingSymbol "Answer a button whose target is the receiver (i.e. a ProjectNavigationMorph), who gets its wording by sending the wordingSelector to me. The given string" | aButton | aButton := UpdatingSimpleButtonMorph new. aButton target: self; borderStyle: BorderStyle raised; color: self colorForButtons; label: '-' font: self fontForButtons; setBalloonText: balloonString translated; actionSelector: actionSymbol; wordingSelector: wordingSymbol. aButton step. ^ aButton ! Item was changed: + ----- Method: ProjectNavigationMorph>>orientationString (in category 'private - ui') ----- - ----- Method: ProjectNavigationMorph>>orientationString (in category 'as yet unclassified') ----- orientationString ^ (self orientedVertically ifTrue: ['<yes>'] ifFalse: ['<no>']) , 'vertical orientation' translated! Item was changed: + ----- Method: ProjectNavigationMorph>>orientedVertically (in category 'private - ui') ----- - ----- Method: ProjectNavigationMorph>>orientedVertically (in category 'as yet unclassified') ----- orientedVertically ^self valueOfProperty: #orientedVertically ifAbsent: [false] ! Item was changed: + ----- Method: ProjectNavigationMorph>>positionVertically (in category 'the actions') ----- - ----- Method: ProjectNavigationMorph>>positionVertically (in category 'as yet unclassified') ----- positionVertically | wb stickToTop | owner == self world ifFalse: [^self]. wb := self worldBounds. stickToTop := self valueOfProperty: #stickToTop. stickToTop ifNil: [ stickToTop := (self top - wb top) abs < (self bottom - wb bottom) abs. self setProperty: #stickToTop toValue: stickToTop. ]. mouseInside == true ifTrue: [ stickToTop ifTrue: [ self top: wb top ] ifFalse: [ self bottom: wb bottom ]. ] ifFalse: [ stickToTop ifTrue: [ self bottom: wb top + self amountToShowWhenSmall ] ifFalse: [ self top: wb bottom - self amountToShowWhenSmall ]. ]. ! Item was changed: + ----- Method: ProjectNavigationMorph>>retractIfAppropriate (in category 'ui') ----- - ----- Method: ProjectNavigationMorph>>retractIfAppropriate (in category 'as yet unclassified') ----- retractIfAppropriate mouseInside := false. self positionVertically. ! Item was changed: + ----- Method: ProjectNavigationMorph>>showMenuFor:event: (in category 'menus') ----- - ----- Method: ProjectNavigationMorph>>showMenuFor:event: (in category 'as yet unclassified') ----- showMenuFor: aSymbol event: evt (aSymbol == #publishProject or: [aSymbol == #publishProjectSimple]) ifTrue: [ self doPublishButtonMenuEvent: evt. ^true "we did show the menu" ]. (aSymbol == #findAProject or: [aSymbol == #findAProjectSimple]) ifTrue: [ self doFindButtonMenuEvent: evt. ^true "we did show the menu" ]. ^false ! Item was changed: + ----- Method: ProjectNavigationMorph>>toggleOrientation (in category 'the actions') ----- - ----- Method: ProjectNavigationMorph>>toggleOrientation (in category 'as yet unclassified') ----- toggleOrientation self setProperty: #orientedVertically toValue: self orientedVertically not. self setProperty: #currentNavigatorVersion toValue: self currentNavigatorVersion - 1. ! Item was changed: + ----- Method: ProjectSorterMorph>>clickFromSorterEvent:morph: (in category 'event handling') ----- - ----- Method: ProjectSorterMorph>>clickFromSorterEvent:morph: (in category 'as yet unclassified') ----- clickFromSorterEvent: evt morph: aMorph | where what | (aMorph bounds containsPoint: evt cursorPoint) ifFalse: [^self]. evt isMouseUp ifFalse: [ evt shiftPressed ifFalse: [^evt hand grabMorph: aMorph]. ^self ]. evt shiftPressed ifTrue: [ where := aMorph owner submorphs indexOf: aMorph ifAbsent: [nil]. what := book threadName. WorldState addDeferredUIMessage: [ InternalThreadNavigationMorph openThreadNamed: what atIndex: where ]. (Project named: (aMorph valueOfProperty: #nameOfThisProject)) enter. ]. ! Item was changed: + ----- Method: ProjectSorterMorph>>insertNewProject: (in category 'controls') ----- - ----- Method: ProjectSorterMorph>>insertNewProject: (in category 'as yet unclassified') ----- insertNewProject: evt | newProj | [newProj := MorphicProject openViewOn: nil.] on: ProjectViewOpenNotification do: [ :ex | ex resume: false]. Smalltalk at: #EToyProjectDetailsMorph ifPresent:[:aClass| aClass getFullInfoFor: newProj ifValid: [ evt hand attachMorph: (self sorterMorphForProjectNamed: newProj name) ] expandedFormat: false. ].! Item was changed: + ----- Method: ProjectSorterMorph>>morphsForMyContentsFrom:sizedTo: (in category 'private') ----- - ----- Method: ProjectSorterMorph>>morphsForMyContentsFrom:sizedTo: (in category 'as yet unclassified') ----- morphsForMyContentsFrom: listOfPages sizedTo: sz | morphsForPageSorter | 'Assembling thumbnail images...' displayProgressFrom: 0 to: listOfPages size during: [:bar | morphsForPageSorter := listOfPages withIndexCollect: [ :each :index | bar value: index. self sorterMorphForProjectNamed: each first ]. ]. ^morphsForPageSorter ! Item was changed: + ----- Method: ProjectSorterMorph>>navigator:listOfPages: (in category 'initialization') ----- - ----- Method: ProjectSorterMorph>>navigator:listOfPages: (in category 'as yet unclassified') ----- navigator: aThreadNavigator listOfPages: listOfPages | morphsForPageSorter pixelsAvailable pixelsNeeded scale | "a bit of fudging to try to outguess the layout mechanism and get best possible scale" pixelsAvailable := Display extent - 130. pixelsAvailable := pixelsAvailable x * pixelsAvailable y. pixelsNeeded := 100@75. pixelsNeeded := pixelsNeeded x * pixelsNeeded y * listOfPages size. scale := (pixelsAvailable / pixelsNeeded min: 1) sqrt. sizeOfEachMorph := (100@75 * scale) rounded. morphsForPageSorter := self morphsForMyContentsFrom: listOfPages sizedTo: sizeOfEachMorph. morphsForPageSorter := morphsForPageSorter reject: [ :each | each isNil]. self changeExtent: Display extent. self book: aThreadNavigator morphsToSort: morphsForPageSorter. pageHolder cursor: aThreadNavigator currentIndex; fullBounds; hResizing: #rigid. ! Item was changed: + ----- Method: ProjectSorterMorph>>sorterMorphForProjectNamed: (in category 'private') ----- - ----- Method: ProjectSorterMorph>>sorterMorphForProjectNamed: (in category 'as yet unclassified') ----- sorterMorphForProjectNamed: projName | pvm proj | (proj := Project named: projName) ifNil: [^nil]. pvm := (InternalThreadNavigationMorph getThumbnailFor: proj) asMorph. pvm setProperty: #nameOfThisProject toValue: projName. pvm isOpaque: true. pvm setBalloonText: projName. pvm on: #mouseDown send: #clickFromSorterEvent:morph: to: self. pvm on: #mouseUp send: #clickFromSorterEvent:morph: to: self. ^pvm ! Item was changed: + ----- Method: ReferenceMorph>>fitContents (in category 'layout') ----- - ----- Method: ReferenceMorph>>fitContents (in category 'misc') ----- fitContents submorphs size = 1 ifTrue: [self extent: submorphs first extent + (2 * self borderWidth). submorphs first position: self position + self borderWidth]! Item was changed: + ----- Method: SorterTokenMorph>>fitContents (in category 'layout') ----- - ----- Method: SorterTokenMorph>>fitContents (in category 'as yet unclassified') ----- fitContents submorphs size = 1 ifTrue: [self bounds: (submorphs first bounds insetBy: (-1 @ -1))]! Item was changed: + ----- Method: SorterTokenMorph>>forMorph: (in category 'initialization') ----- - ----- Method: SorterTokenMorph>>forMorph: (in category 'as yet unclassified') ----- forMorph: aMorph | it | morphRepresented := aMorph. aMorph submorphs notEmpty ifTrue: [self addMorphBack: (it := aMorph submorphs first veryDeepCopy). it position: self position + (1 @ 1). it lock]. self fitContents! Item was changed: + ----- Method: SqueakPage class>>initialize (in category 'class initialization') ----- - ----- Method: SqueakPage class>>initialize (in category 'as yet unclassified') ----- initialize "SqueakPage initialize" MaxThumbnailWidthOrHeight := 60. ! Item was changed: + ----- Method: SqueakPage class>>newURLAndPageFor: (in category 'instance creation') ----- - ----- Method: SqueakPage class>>newURLAndPageFor: (in category 'as yet unclassified') ----- newURLAndPageFor: aMorph "Create a new SqueakPage whose contents is the given morph. Assign a URL for that page, record it in the page cache, and answer its URL." | pg newURL stamp | pg := self new. stamp := Utilities authorInitialsPerSe. stamp isEmptyOrNil ifTrue: [ stamp := '*' ]. pg saveMorph: aMorph author: stamp. newURL := SqueakPageCache generateURL. SqueakPageCache atURL: newURL put: pg. ^ newURL! Item was changed: + ----- Method: SqueakPage class>>stemUrl: (in category 'utilties') ----- - ----- Method: SqueakPage class>>stemUrl: (in category 'as yet unclassified') ----- stemUrl: aUrlString "Peel off the 'x5.sp' or '.bo' from the end of a url of a SqueakPage or a BookMorph index file" | ll aUrl | ll := aUrlString findLast: [:char | char == $.]. ll = 0 ifTrue: [aUrl := aUrlString] ifFalse: [aUrl := aUrlString copyFrom: 1 to: ll-1]. "remove .sp" aUrl := (aUrl stemAndNumericSuffix) at: 1. "remove trailing number" aUrl size = 0 ifTrue: [^ aUrl]. "empty" [aUrl last == $x] whileTrue: [aUrl := aUrl allButLast]. ^ aUrl! Item was changed: + ----- Method: StickyPadMorph class>>registerInFlapsRegistry (in category 'class initialization') ----- - ----- Method: StickyPadMorph class>>registerInFlapsRegistry (in category 'as yet unclassified') ----- registerInFlapsRegistry "Register the receiver in the system's flaps registry" self environment at: #Flaps ifPresent: [:cl | cl registerQuad: {#StickyPadMorph. #newStandAlone. 'Sticky Pad' translatedNoop. 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.' translatedNoop} forFlapNamed: 'Supplies'. cl registerQuad: {#StickyPadMorph. #newStandAlone. 'Sticky Pad' translatedNoop. 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.' translatedNoop} forFlapNamed: 'PlugIn Supplies'.]! Item was changed: + ----- Method: TabMorph>>convertToReferenceMorph (in category 'converting') ----- - ----- Method: TabMorph>>convertToReferenceMorph (in category 'as yet unclassified') ----- convertToReferenceMorph | aMorph | aMorph := ReferenceMorph new referent: morphToInstall. aMorph position: self position. self becomeForward: aMorph.! Item was changed: + ----- Method: TabMorph>>isHighlighted (in category 'testing') ----- - ----- Method: TabMorph>>isHighlighted (in category 'as yet unclassified') ----- isHighlighted ^ false! Item was changed: + ----- Method: TabMorph>>morphToInstall (in category 'accessing') ----- - ----- Method: TabMorph>>morphToInstall (in category 'as yet unclassified') ----- morphToInstall ^ morphToInstall! Item was changed: + ----- Method: TabMorph>>morphToInstall: (in category 'accessing') ----- - ----- Method: TabMorph>>morphToInstall: (in category 'as yet unclassified') ----- morphToInstall: m morphToInstall := m. self contents: m externalName. self actionSelector: #tabSelected. self target: self! Item was changed: + ----- Method: TabMorph>>tabSelected (in category 'tabs') ----- - ----- Method: TabMorph>>tabSelected (in category 'as yet unclassified') ----- tabSelected "Called when the receiver is hit. First, bulletproof against someone having taken the structure apart. My own action basically requires that my grand-owner be a TabbedPalette" self player ifNotNil: [self player runAllOpeningScripts ifTrue: [^ self]]. (owner isKindOf: IndexTabs) ifFalse: [^ Beeper beep]. (owner owner isKindOf: TabbedPalette) ifFalse: [^ Beeper beep]. owner owner selectTab: self! Item was changed: + ----- Method: TabSorterMorph>>acceptSort (in category 'buttons') ----- - ----- Method: TabSorterMorph>>acceptSort (in category 'as yet unclassified') ----- acceptSort "Reconstitute the palette based on what is found in the sorter" | rejects oldOwner tabsToUse oldTop | tabsToUse := OrderedCollection new. rejects := OrderedCollection new. pageHolder submorphs doWithIndex: [:m :i | | appearanceMorph toAdd aMenu | toAdd := nil. (m isKindOf: BookMorph) ifTrue: [toAdd := SorterTokenMorph forMorph: m]. (m isKindOf: SorterTokenMorph) ifTrue: [toAdd := m morphRepresented. (toAdd referent isKindOf: MenuMorph) ifTrue: [(aMenu := toAdd referent) setProperty: #paletteMenu toValue: true. (aMenu submorphs size > 1 and: [(aMenu submorphs second isKindOf: MenuItemMorph) and: [aMenu submorphs second contents = 'dismiss this menu']]) ifTrue: [aMenu submorphs first delete. "delete title" aMenu submorphs first delete. "delete stay-up item" (aMenu submorphs first knownName = #line) ifTrue: [aMenu submorphs first delete]]]. toAdd removeAllMorphs. toAdd addMorph: (appearanceMorph := m submorphs first). appearanceMorph position: toAdd position. appearanceMorph lock. toAdd fitContents]. toAdd ifNil: [rejects add: m] ifNotNil: [tabsToUse add: toAdd]]. tabsToUse isEmpty ifTrue: [^self inform: 'Sorry, must have at least one tab']. book newTabs: tabsToUse. book tabsMorph color: pageHolder color. oldTop := self topRendererOrSelf. "in case some maniac has flexed the sorter" oldOwner := oldTop owner. oldTop delete. oldOwner addMorphFront: book! Item was changed: + ----- Method: TabSorterMorph>>cancelSort (in category 'buttons') ----- - ----- Method: TabSorterMorph>>cancelSort (in category 'as yet unclassified') ----- cancelSort | oldOwner | oldOwner := owner. self delete. oldOwner addMorphFront: book! Item was changed: + ----- Method: TabSorterMorph>>sortTabsFor: (in category 'sorting') ----- - ----- Method: TabSorterMorph>>sortTabsFor: (in category 'as yet unclassified') ----- sortTabsFor: aTabbedPalette | actualTabs | actualTabs := aTabbedPalette tabMorphs. self book: aTabbedPalette morphsToSort: (actualTabs collect: [:aTab | aTab sorterToken]). pageHolder color: aTabbedPalette tabsMorph color. self position: aTabbedPalette position. pageHolder extent: self extent. self setNameTo: 'Tab Sorter for ', aTabbedPalette externalName. aTabbedPalette owner addMorphFront: self! Item was changed: + ----- Method: TextPlusJumpEnd>>emphasizeScanner: (in category 'accessing') ----- - ----- Method: TextPlusJumpEnd>>emphasizeScanner: (in category 'as yet unclassified') ----- emphasizeScanner: scanner "none for me, thanks"! Item was changed: + ----- Method: TextPlusJumpEnd>>jumpLabel (in category 'accessing') ----- - ----- Method: TextPlusJumpEnd>>jumpLabel (in category 'as yet unclassified') ----- jumpLabel ^jumpLabel! Item was changed: + ----- Method: TextPlusJumpEnd>>jumpLabel: (in category 'accessing') ----- - ----- Method: TextPlusJumpEnd>>jumpLabel: (in category 'as yet unclassified') ----- jumpLabel: aString jumpLabel := aString! Item was changed: + ----- Method: TextPlusJumpStart>>actOnClickFor: (in category 'mouse events') ----- - ----- Method: TextPlusJumpStart>>actOnClickFor: (in category 'as yet unclassified') ----- actOnClickFor: model "Subclasses may override to provide, eg, hot-spot actions" model doJumpTo: jumpLabel. ^ true! Item was changed: + ----- Method: TextPlusJumpStart>>emphasizeScanner: (in category 'accessing') ----- - ----- Method: TextPlusJumpStart>>emphasizeScanner: (in category 'as yet unclassified') ----- emphasizeScanner: scanner "Set the emphasist for text scanning" scanner addEmphasis: 4! Item was changed: + ----- Method: TextPlusJumpStart>>jumpLabel (in category 'accessing') ----- - ----- Method: TextPlusJumpStart>>jumpLabel (in category 'as yet unclassified') ----- jumpLabel ^jumpLabel! Item was changed: + ----- Method: TextPlusJumpStart>>jumpLabel: (in category 'accessing') ----- - ----- Method: TextPlusJumpStart>>jumpLabel: (in category 'as yet unclassified') ----- jumpLabel: aString jumpLabel := aString! Item was changed: + ----- Method: TextPlusMorph>>addAlansAnchorFor: (in category 'menus') ----- - ----- Method: TextPlusMorph>>addAlansAnchorFor: (in category 'as yet unclassified') ----- addAlansAnchorFor: aMorph | ed attribute selRects | self removeAlansAnchorFor: aMorph. ed := self editor. attribute := TextAnchor new anchoredMorph: aMorph. aMorph setProperty: #geeMailLeftOffset toValue: aMorph left - self left. ed replaceSelectionWith: (ed selection addAttribute: attribute). selRects := self paragraph selectionRects. selRects isEmpty ifFalse: [ aMorph top: selRects first top ]. self releaseParagraphReally. self layoutChanged. ! Item was changed: + ----- Method: TextPlusMorph>>addColumnBreak (in category 'menus') ----- - ----- Method: TextPlusMorph>>addColumnBreak (in category 'as yet unclassified') ----- addColumnBreak | ed old new break | ed := self editor. old := ed selection. break := Character characterForColumnBreak asString. break := Text string: break attributes: {}. new := old ,break. ed replaceSelectionWith: new. self releaseParagraphReally. self layoutChanged. ! Item was changed: + ----- Method: TextPlusMorph>>addItem: (in category 'add/remove') ----- - ----- Method: TextPlusMorph>>addItem: (in category 'as yet unclassified') ----- addItem: classAndMethod "Make a linked message list and put this method in it" Model new addItem: classAndMethod "let him do all the work"! Item was changed: + ----- Method: TextPlusMorph>>addJumpBeginning (in category 'menus') ----- - ----- Method: TextPlusMorph>>addJumpBeginning (in category 'as yet unclassified') ----- addJumpBeginning | ed attribute jumpEnd mySelection a1 ax | ed := self editor. (mySelection := ed selection) isEmpty ifTrue: [^self inform: 'Please select something first']. jumpEnd := self chooseOneJumpEnd. jumpEnd isEmptyOrNil ifTrue: [^self]. attribute := TextPlusJumpStart new jumpLabel: jumpEnd. a1 := (mySelection attributesAt: 1) reject: [ :each | each isKindOf: TextPlusJumpStart]. ax := (mySelection attributesAt: mySelection size) reject: [ :each | each isKindOf: TextPlusJumpStart]. ed replaceSelectionWith: (Text string: '*' attributes: a1), (mySelection addAttribute: attribute), (Text string: '*' attributes: ax). self releaseParagraphReally. self layoutChanged. ! Item was changed: + ----- Method: TextPlusMorph>>addJumpEnd (in category 'menus') ----- - ----- Method: TextPlusMorph>>addJumpEnd (in category 'as yet unclassified') ----- addJumpEnd | ed attribute jumpLabel selectedString | ed := self editor. selectedString := ed selection asString. selectedString isEmpty ifTrue: [^self inform: 'Please select something first']. jumpLabel := UIManager default request: 'Name this place' initialAnswer: selectedString. jumpLabel isEmpty ifTrue: [^self]. self removeJumpEndFor: jumpLabel. attribute := TextPlusJumpEnd new jumpLabel: jumpLabel. ed replaceSelectionWith: (ed selection addAttribute: attribute). ! Item was changed: + ----- Method: TextPlusMorph>>allJumpEndStrings (in category 'private - menus') ----- - ----- Method: TextPlusMorph>>allJumpEndStrings (in category 'as yet unclassified') ----- allJumpEndStrings | answer | answer := OrderedCollection new. text runs withStartStopAndValueDo: [:start :stop :attributes | attributes do: [:att | (att isMemberOf: TextPlusJumpEnd) ifTrue: [ (answer includes: att jumpLabel) ifFalse: [answer add: att jumpLabel]. ] ] ]. ^answer ! Item was changed: + ----- Method: TextPlusMorph>>chooseOneJumpEnd (in category 'private - menus') ----- - ----- Method: TextPlusMorph>>chooseOneJumpEnd (in category 'as yet unclassified') ----- chooseOneJumpEnd ^UIManager default chooseFrom: self allJumpEndStrings values: self allJumpEndStrings title: 'Possible jump ends'. ! Item was changed: + ----- Method: TextPlusMorph>>doJumpTo: (in category 'jumping') ----- - ----- Method: TextPlusMorph>>doJumpTo: (in category 'as yet unclassified') ----- doJumpTo: aString | myStart myStop | myStart := myStop := nil. text runs withStartStopAndValueDo: [:start :stop :attributes | attributes do: [:att | ((att isMemberOf: TextPlusJumpEnd) and: [att jumpLabel = aString]) ifTrue: [ myStart ifNil: [myStart := start. myStop := stop] ifNotNil: [myStart := myStart min: start. myStop := myStop max: stop]. ] ] ]. myStart ifNil: [^self]. self editor selectFrom: myStart to: myStop. ignoreNextUp := true. self changed. self scrollSelectionToTop. ! Item was changed: + ----- Method: TextPlusMorph>>doYellowButtonPress: (in category 'menus') ----- - ----- Method: TextPlusMorph>>doYellowButtonPress: (in category 'as yet unclassified') ----- doYellowButtonPress: evt | menu | menu := MenuMorph new. menu add: 'Go to top of document' action: [self jumpToDocumentTop]; add: 'Move selection to top of page' action: [self scrollSelectionToTop]; add: 'Add column break' action: [self addColumnBreak]; add: 'Define as jump start' action: [self addJumpBeginning]; add: 'Define as jump end' action: [self addJumpEnd]. menu title: 'Text navigation options'. menu invokeModal. ! Item was changed: + ----- Method: TextPlusMorph>>fixAllLeftOffsets (in category 'private - linked frames') ----- - ----- Method: TextPlusMorph>>fixAllLeftOffsets (in category 'as yet unclassified') ----- fixAllLeftOffsets text runs withStartStopAndValueDo: [:start :stop :attributes | attributes do: [:att | | am | (att isMemberOf: TextAnchor) ifTrue: [ am := att anchoredMorph. (am isNil or: [am world isNil]) ifFalse: [ am valueOfProperty: #geeMailLeftOffset ifAbsent: [ am setProperty: #geeMailLeftOffset toValue: am left - self left ] ] ] ] ]. ! Item was changed: + ----- Method: TextPlusMorph>>jumpToDocumentTop (in category 'jumping') ----- - ----- Method: TextPlusMorph>>jumpToDocumentTop (in category 'as yet unclassified') ----- jumpToDocumentTop self editor selectFrom: 1 to: 0. self changed. self scrollSelectionToTop. ! Item was changed: + ----- Method: TextPlusMorph>>keyboardFocusLostForSure (in category 'private') ----- - ----- Method: TextPlusMorph>>keyboardFocusLostForSure (in category 'as yet unclassified') ----- keyboardFocusLostForSure editor ifNotNil: [ self selectionChanged. self paragraph selectionStart: nil selectionStop: nil. editor := nil ]. ! Item was changed: + ----- Method: TextPlusMorph>>linkNewlyDroppedMorph: (in category 'private') ----- - ----- Method: TextPlusMorph>>linkNewlyDroppedMorph: (in category 'as yet unclassified') ----- linkNewlyDroppedMorph: aMorph | ed para lineToUse | ed := self editor. para := self paragraph. lineToUse := para lines detect: [ :each | each bottom > aMorph top] ifNone: [para lines last]. ed selectFrom: lineToUse first to: lineToUse last. self addAlansAnchorFor: aMorph. ! Item was changed: + ----- Method: TextPlusMorph>>makeSuccessorMorph (in category 'private - linked frames') ----- - ----- Method: TextPlusMorph>>makeSuccessorMorph (in category 'as yet unclassified') ----- makeSuccessorMorph | newMorph | self fixAllLeftOffsets. newMorph := self copy predecessor: self successor: successor. newMorph extent: self width @ 100. successor ifNotNil: [successor setPredecessor: newMorph]. self setSuccessor: newMorph. successor recomposeChain. ^newMorph! Item was changed: + ----- Method: TextPlusMorph>>parentGeeMail (in category 'private') ----- - ----- Method: TextPlusMorph>>parentGeeMail (in category 'as yet unclassified') ----- parentGeeMail ^self ownerThatIsA: GeeMailMorph ! Item was changed: + ----- Method: TextPlusMorph>>removeAlansAnchorFor: (in category 'menus') ----- - ----- Method: TextPlusMorph>>removeAlansAnchorFor: (in category 'as yet unclassified') ----- removeAlansAnchorFor: aMorph | anchors | anchors := OrderedCollection new. text runs withStartStopAndValueDo: [:start :stop :attributes | attributes do: [:att | (att isMemberOf: TextAnchor) ifTrue: [ (att anchoredMorph isNil or: [ att anchoredMorph == aMorph or: [att anchoredMorph world isNil]]) ifTrue: [ anchors add: {att. start. stop} ] ] ] ]. anchors do: [ :old | text removeAttribute: old first from: old second to: old third. ]. ! Item was changed: + ----- Method: TextPlusMorph>>removeJumpEndFor: (in category 'private - menus') ----- - ----- Method: TextPlusMorph>>removeJumpEndFor: (in category 'as yet unclassified') ----- removeJumpEndFor: aString | anchors | anchors := OrderedCollection new. text runs withStartStopAndValueDo: [:start :stop :attributes | attributes do: [:att | (att isMemberOf: TextPlusJumpEnd) ifTrue: [ att jumpLabel == aString ifTrue: [ anchors add: {att. start. stop} ] ] ] ]. anchors do: [ :old | text removeAttribute: old first from: old second to: old third. ]. ! Item was changed: + ----- Method: TextPlusMorph>>repositionAnchoredMorphs (in category 'private') ----- - ----- Method: TextPlusMorph>>repositionAnchoredMorphs (in category 'as yet unclassified') ----- repositionAnchoredMorphs | firstCharacterIndex lastCharacterIndex | firstCharacterIndex := self paragraph firstCharacterIndex. lastCharacterIndex := paragraph lastCharacterIndex. text runs withStartStopAndValueDo: [:start :stop :attributes | attributes do: [:att | | leftShift am cBlock | (att isMemberOf: TextAnchor) ifTrue: [ am := att anchoredMorph. (am isNil or: [am world isNil]) ifFalse: [ (stop between: firstCharacterIndex and: lastCharacterIndex) ifTrue: [ cBlock := self paragraph characterBlockForIndex: stop. leftShift := am valueOfProperty: #geeMailLeftOffset ifAbsent: [0]. am position: (self left + leftShift) @ cBlock origin y. ]. ] ] ] ]. ! Item was changed: + ----- Method: TextPlusMorph>>scrollSelectionToTop (in category 'menus') ----- - ----- Method: TextPlusMorph>>scrollSelectionToTop (in category 'as yet unclassified') ----- scrollSelectionToTop (self parentGeeMail ifNil: [^self]) scrollSelectionIntoView: nil alignTop: true inTextMorph: self. ! Item was changed: + ----- Method: TextPlusMorph>>textPlusMenuFor: (in category 'menus') ----- - ----- Method: TextPlusMorph>>textPlusMenuFor: (in category 'as yet unclassified') ----- textPlusMenuFor: aMorph | menu | menu := MenuMorph new. menu add: 'Link to text selection' target: [self addAlansAnchorFor: aMorph] selector: #value; add: 'Unlink from text selection' target: [self removeAlansAnchorFor: aMorph] selector: #value; add: 'Delete' target: [ self removeAlansAnchorFor: aMorph. aMorph delete. ] selector: #value. ^menu ! Item was changed: + ----- Method: TextPlusPasteUpMorph>>allTextPlusMorphs (in category 'private') ----- - ----- Method: TextPlusPasteUpMorph>>allTextPlusMorphs (in category 'as yet unclassified') ----- allTextPlusMorphs ^submorphs select: [ :each | each isKindOf: TextPlusMorph] ! Item was changed: + ----- Method: TextPlusPasteUpMorph>>disablePageBreaksWhile: (in category 'drawing') ----- - ----- Method: TextPlusPasteUpMorph>>disablePageBreaksWhile: (in category 'as yet unclassified') ----- disablePageBreaksWhile: aBlock | save result | save := showPageBreaks. showPageBreaks := false. result := aBlock value. showPageBreaks := save. ^result ! Item was changed: + ----- Method: TextPlusPasteUpMorph>>fullDrawForPrintingOn: (in category 'postscript canvases') ----- - ----- Method: TextPlusPasteUpMorph>>fullDrawForPrintingOn: (in category 'as yet unclassified') ----- fullDrawForPrintingOn: aCanvas self disablePageBreaksWhile: [self fullDrawOn: aCanvas]. ! Item was changed: + ----- Method: TextPlusPasteUpMorph>>nearestTextPlusMorphTo: (in category 'private') ----- - ----- Method: TextPlusPasteUpMorph>>nearestTextPlusMorphTo: (in category 'as yet unclassified') ----- nearestTextPlusMorphTo: aMorph ^self allTextPlusMorphs inject: nil into: [ :best :each | self select: best or: each asClosestTo: aMorph ]! Item was changed: + ----- Method: TextPlusPasteUpMorph>>printer (in category 'drawing') ----- - ----- Method: TextPlusPasteUpMorph>>printer (in category 'as yet unclassified') ----- printer ^GeePrinter new pasteUp: self; printSpecs: self printSpecs! Item was changed: + ----- Method: TextPlusPasteUpMorph>>select:or:asClosestTo: (in category 'private') ----- - ----- Method: TextPlusPasteUpMorph>>select:or:asClosestTo: (in category 'as yet unclassified') ----- select: bestPrevious or: current asClosestTo: aMorph bestPrevious ifNil: [^current]. (bestPrevious bounds intersects: aMorph bounds) ifTrue: [^bestPrevious]. (current bounds intersects: aMorph bounds) ifTrue: [^current]. bestPrevious left < current left ifTrue: [ ^aMorph left < current left ifTrue: [bestPrevious] ifFalse: [current] ]. ^aMorph left < bestPrevious left ifTrue: [current] ifFalse: [bestPrevious] ! Item was changed: + ----- Method: TextPlusPasteUpMorph>>showPageBreaksString (in category 'menus') ----- - ----- Method: TextPlusPasteUpMorph>>showPageBreaksString (in category 'as yet unclassified') ----- showPageBreaksString ^ (showPageBreaks ifTrue: ['<on>'] ifFalse: ['<off>']) , 'show page breaks' translated! Item was changed: + ----- Method: TextPlusPasteUpMorph>>textPlusMenuFor: (in category 'menus') ----- - ----- Method: TextPlusPasteUpMorph>>textPlusMenuFor: (in category 'as yet unclassified') ----- textPlusMenuFor: aMorph ^(self nearestTextPlusMorphTo: aMorph) textPlusMenuFor: aMorph ! Item was changed: + ----- Method: TextPlusPasteUpMorph>>togglePageBreaks (in category 'menus') ----- - ----- Method: TextPlusPasteUpMorph>>togglePageBreaks (in category 'as yet unclassified') ----- togglePageBreaks showPageBreaks := showPageBreaks not. self changed! Item was changed: + ----- Method: ThreadNavigationMorph class>>example1 (in category 'examples') ----- - ----- Method: ThreadNavigationMorph class>>example1 (in category 'as yet unclassified') ----- example1 " ThreadNavigationMorph example1 " self new listOfPages: #( ('ftp://209.143.91.36/Drive A Car') ('ftp://209.143.91.36/Teachers & NewTech' 1) ('ftp://209.143.91.36/Teachers & NewTech' 2) ('ftp://209.143.91.36/Lander') ); openInWorld! Item was changed: + ----- Method: ThumbnailMorph class>>recursionReset (in category 'maintenance') ----- - ----- Method: ThumbnailMorph class>>recursionReset (in category 'as yet unclassified') ----- recursionReset "ThumbnailMorph recursionReset" "Reset the RecursionDepth counter in case the user interrupted during a thumbnail being drawn. Do this just once in a while when no drawOn: is being called. tk 9/8/97" RecursionDepth := 0.! Item was changed: + ----- Method: TrashCanMorph class>>playDeleteSound (in category 'sound playing') ----- - ----- Method: TrashCanMorph class>>playDeleteSound (in category 'as yet unclassified') ----- playDeleteSound "TrashCanMorph playDeleteSound" SoundService default playSampledSound: self samplesForDelete rate: 22050! Item was changed: + ----- Method: TrashCanMorph class>>playMouseEnterSound (in category 'sound playing') ----- - ----- Method: TrashCanMorph class>>playMouseEnterSound (in category 'as yet unclassified') ----- playMouseEnterSound "TrashCanMorph playMouseEnterSound" SoundService default playSampledSound: self samplesForMouseEnter rate: 22050! Item was changed: + ----- Method: TrashCanMorph class>>playMouseLeaveSound (in category 'sound playing') ----- - ----- Method: TrashCanMorph class>>playMouseLeaveSound (in category 'as yet unclassified') ----- playMouseLeaveSound "TrashCanMorph playMouseLeaveSound" SoundService default playSampledSound: self samplesForMouseLeave rate: 22050! Item was changed: + ----- Method: TrashCanMorph class>>samplesForDelete (in category 'sound samples') ----- - ----- Method: TrashCanMorph class>>samplesForDelete (in category 'as yet unclassified') ----- (excessive size, no diff calculated) Item was changed: + ----- Method: TrashCanMorph class>>samplesForMouseEnter (in category 'sound samples') ----- - ----- Method: TrashCanMorph class>>samplesForMouseEnter (in category 'as yet unclassified') ----- samplesForMouseEnter ^ #(-37 -24 -30 -30 -25 -23 -11 -8 -38 -40 -34 -21 -18 -27 -34 -20 2 11 8 10 5 7 10 14 34 28 34 54 59 47 54 25 27 43 33 48 23 40 59 63 47 46 27 47 43 41 46 50 64 57 46 57 44 48 12 17 24 28 18 23 27 -7 -17 2 4 1 -4 18 12 11 34 25 43 18 11 20 43 43 11 12 31 -5 -11 -43 -41 -17 -23 -28 -38 -33 -48 -64 -61 -53 -61 -54 -56 -73 -73 -48 -48 -63 -92 -102 -90 -92 -115 -93 -90 -109 -120 -112 -119 -141 -136 -128 -146 -143 -141 -129 -118 -139 -132 -120 -103 -100 -96 -79 -71 -83 -79 -77 -87 -73 -73 -43 -24 -5 -10 20 23 -5 -4 0 28 20 -11 20 4 -11 -23 20 27 7 8 -2 -7 -15 -27 4 0 -8 -34 -31 -38 -34 -50 -40 -64 -46 -59 -51 -82 -80 -82 -80 -89 -95 -122 -89 -97 -67 -64 -31 -21 -34 -56 -25 -35 -48 -63 -37 -54 -34 8 40 82 161 306 503 921 1638 2549 3458 4074 4290 3947 2988 1528 -293 -2417 -4592 -6693 -8734 -10727 -12641 -14255 -15466 -16249 -16383 -15965 -15159 -14019 -12574 -10934 -9124 -7214 -5191 -3092 -856 1418 3639 5667 7543 9156 10532 11608 12361 12795 12922 12755 12307 11574 10473 8964 7129 5084 2911 596 -1773 -4103 -6374 -8593 -10593 -12355 -13748 -14599 -14866 -14527 -13593 -12109 -10146 -7697 -4933 -2022 881 3689 6302 8638 10580 12067 13052 13602 13774 13543 13046 12276 11271 9965 8426 6677 4771 2731 607 -1469 -3420 -5217 -6790 -8196 -9401 -10377 -11001 -11242 -11095 -10600 -9729 -8581 -7114 -5423 -3563 -1566 488 2577 4556 6448 8234 9786 11143 12136 12756 13034 12936 12489 11744 10678 9320 7673 5775 3813 1813 -182 -2113 -3924 -5606 -7123 -8439 -9477 -10213 -10688 -10855 -10663 -10109 -9278 -8125 -6682 -5004 -3147 -1171 791 2762 4655 6386 7944 9222 10201 10800 11120 11163 10885 10313 9434 8363 7050 5604 4048 2395 711 -872 -2376 -3707 -4894 -5875 -6667 -7214 -7489 -7480 -7251 -6739 -6039 -5102 -3987 -2754 -1475 -207 1094 2392 3590 4686 5639 6469 7178 7758 8142 8273 8187 7883 7398 6803 6056 5188 4152 3075 1968 866 -184 -1197 -2143 -2964 -3615 -4163 -4572 -4907 -5100 -5141 -5018 -4723 -4288 -3725 -3031 -2198 -1246 -276 704 1661 2529 3377 4140 4835 5333 5721 5941 6098 6048 58 46 5498 5047 4467 3816 3131 2444 1659 856 57 -636 -1301 -1946 -2549 -3099 -3548 -3871 -4057 -4143 -4153 -3999 -3753 -3380 -2893 -2338 -1742 -1098 -391 380 1111 1822 2543 3206 3784 4283 4638 4868 4955 4894 4713 4385 3938 3365 2679 1910 1089 272 -564 -1379 -2145 -2902 -3583 -4127 -4562 -4866 -5010 -4949 -4785 -4468 -4026 -3463 -2817 -2070 -1256 -398 462 1297 2147 2922 3613 4211 4732 5178 5449 5617 5608 5456 5168 4727 4120 3404 2561 1646 706 -218 -1212 -2160 -3018 -3688 -4293 -4726 -5015 -5195 -5231 -5096 -4788 -4321 -3754 -3057 -2240 -1363 -433 515 1446 2340 3118 3820 4401 4851 5133 5256 5195 5011 4696 4209 3627 2934 2168 1334 434 -475 -1357 -2211 -2981 -3669 -4285 -4771 -5116 -5322 -5382 -5315 -5067 -4701 -4169 -3518 -2775 -1937 -1036 -165 735 1626 2440 3115 3681 4154 4467 4625 4681 4589 4344 4008 3583 3008 2353 1615 777 -57 -872 -1713 -2486 -3206 -3843 -4391 -4840 -5116 -5273 -5277 -5128 -4831 -4418 -3868 -3252 -2533 -1744 -898 -67 780 1570 2300 2913 3463 3874 4159 4331 4353 4248 40 28 3668 3184 2633 1949 1216 426 -341 -1109 -1852 -2512 -3102 -3597 -3983 -4224 -4349 -4339 -4183 -3910 -3520 -3065 -2510 -1885 -1242 -588 54 685 1249 1839 2352 2777 3106 3327 3466 3488 3417 3234 2948 2617 2185 1671 1117 564 -15 -608 -1174 -1700 -2196 -2650 -3039 -3296 -3481 -3587 -3568 -3460 -3273 -2983 -2614 -2156 -1658 -1154 -626 -89 421 921 1413 1865 2266 2602 2818 3004 3090 3036 2944 2824 2565 2214 1837 1422 954 469 -15 -490 -960 -1413 -1806 -2139 -2421 -2703 -2877 -2949 -2974 -2964 -2820 -2608 -2340 -1972 -1592 -1154 -680 -190 267 745 1183 1592 1947 2225 2473 2624 2696 2723 2692 2565 2408 2219 1916 1579 1200 797 368 -115 -549 -994 -1408 -1767 -2037 -2241 -2394 -2469 -2497 -2427 -2317 -2150 -1887 -1551 -1197 -778 -346 103 544 942 1390 1766 2077 2353 2535 2657 2697 2700 2615 2473 2257 1980 1677 1287 871 466 21 -377 -757 -1134 -1464 -1713 -1932 -2096 -2208 -2243 -2235 -2168 -2051 -1854 -1566 -1229 -888 -499 -100 319 719 1124 1481 1801 2084 2306 2434 2469 2476 2431 2287 2101 1825 1 527 1194 836 483 123 -231 -593 -931 -1251 -1541 -1796 -1978 -2122 -2188 -2162 -2106 -1903 -1717 -1467 -1140 -814 -463 -115 254 617 950 1284 1550 1753 1880 1992 1988 1930 1829 1695 1475 1226 924 603 293 -27 -345 -640 -954 -1217 -1471 -1687 -1832 -1917 -1985 -1960 -1900 -1750 -1546 -1356 -1092 -771 -469 -135 200 555 895 1176 1429 1628 1786 1920 1968 1966 1924 1842 1704 1464 1200 922 600 285 -21 -348 -614 -840 -1073 -1266 -1397 -1501 -1595 -1635 -1638 -1585 -1464 -1311 -1151 -971 -735 -501 -267 -43 210 398 643 865 1050 1206 1333 1419 1418 1410 1383 1281 1147 996 803 621 437 226 23 -148 -309 -466 -611 -748 -849 -912 -964 -1016 -1039 -1032 -990 -868 -757 -621 -440 -256 -118 43 194 354 470 564 653 718 780 809 793 748 672 587 453 321 151 8 -142 -308 -499 -647 -819 -950 -1073 -1169 -1243 -1276 -1282 -1262 -1219 -1140 -1016 -921 -809 -624 -475 -335 -142 25 182 339 483 613 702 796 856 899 898 902 858 826 735 656 529 395 263 146 -14 -167 -346 -480 -633 -715 -806 -878 -955 -958 -978 -930 -891 - 794 -705 -616 -477 -336 -243 -112 4 109 205 276 332 430 480 519 508 521 513 518 463 384 319 227 112 -8 -100 -202 -348 -505 -596 -725 -833 -906 -951 -940 -927 -883 -806 -692 -542 -365 -207 -60 80 249 400 483 584 626 650 657 634 585 493 443 351 238 158 63 -30 -123 -185 -279 -359 -400 -470 -529 -570 -561 -594 -601 -588 -570 -524 -477 -414 -328 -236 -141 -37 48 99 204 287 391 441 472 495 516 476 418 371 292 204 99 -10 -43 -118 -207 -253 -303 -341 -349 -359 -342 -338 -305 -264 -227 -164 -119 -46 38 99 138 174 227 234 215 231 262 234 227 237 273 218 198 192 192 135 119 90 44 -27 -40 -73 -99 -132 -149 -154 -128 -92 -46 -23 38 59 59 51 57 50 28 17 37 -10 2 -4 -40 -71 -96 -126 -142 -194 -227 -274 -300 -345 -362 -369 -357 -345 -335 -303 -256 -223 -191 -141 -116 -71 -80 -96 -74 -86 -120 -141 -181 -249 -315 -372 -388 -397 -430 -449 -460 -462 -417 -391 -357 -299 -253 -175 -119 -34 43 128 198 241 282 357 410 436 444 472 473 441 413 358 260 191 96 -12 -74 -164 -270 -346 -437 -513 -594 -652 -704 -7 28 -750 -735 -668 -626 -544 -456 -341 -244 -138 -34 89 195 293 381 459 476 549 597 600 620 601 572 532 475 417 351 233 135 63 -44 -142 -230 -295 -385 -405 -450 -472 -492 -463 -482 -477 -460 -440 -393 -339 -326 -257 -190 -126 -35 63 146 201 283 355 393 401 427 441 411 382 335 282 241 200 133 90 30 -8 -64 -116 -142 -175 -213 -223 -244 -274 -280 -272 -280 -264 -241 -262 -249 -228 -211 -156 -128 -64 -21 43 80 129 142 187 215 227 230 237 243 254 266 267 273 256 254 251 253 236 208 164 128 69 54 30 -18 -69 -86 -106 -143 -167 -188 -218 -246 -247 -233 -220 -169 -138 -95 -44 -23 18 69 116 188 236 298 380 440 503 516 538 544 516 485 475 427 374 310 292 220 109 57 5 -100 -184 -276 -362 -436 -480 -512 -539 -531 -524 -511 -452 -371 -302 -260 -169 -95 -46 59 156 208 262 336 397 421 436 441 427 427 414 368 332 298 237 197 145 93 46 0 -48 -89 -112 -138 -132 -118 -73 -23 0). ! Item was changed: + ----- Method: TrashCanMorph class>>samplesForMouseLeave (in category 'sound samples') ----- - ----- Method: TrashCanMorph class>>samplesForMouseLeave (in category 'as yet unclassified') ----- samplesForMouseLeave ^ #(230 254 256 242 234 246 206 211 179 175 133 111 106 91 46 53 35 54 17 40 67 98 79 114 127 167 162 133 130 119 91 82 98 90 75 87 45 19 -17 1 -16 -1 8 12 -1 53 71 85 109 117 106 159 138 154 133 161 122 138 85 72 67 51 46 20 6 3 -8 8 -8 -4 -1 22 38 53 43 85 71 103 88 87 45 51 43 59 16 -9 -17 1 -45 -20 -32 -8 -38 3 -20 20 43 53 43 37 24 54 30 58 59 32 20 33 17 8 -30 -56 -72 -111 -133 -127 -122 -111 -129 -111 -108 -112 -108 -111 -135 -100 -130 -111 -158 -125 -121 -104 -96 -111 -135 -106 -111 -104 -133 -111 -143 -137 -140 -130 -109 -103 -119 -62 -59 -67 -62 -33 -41 -12 -43 -46 -43 -38 -71 -87 -100 -80 -125 -124 -145 -132 -145 -111 -148 -106 -95 -79 -51 -14 -17 8 22 85 93 111 116 127 138 133 96 67 53 72 45 -22 -30 -20 -33 16 27 121 177 335 500 756 1023 1362 1738 2131 2465 2769 2932 3032 2951 2609 1980 1102 -43 -1326 -2769 -4181 -5598 -6852 -7906 -8630 -9014 -8982 -8390 -7257 -5645 -3637 -1415 1029 3476 5953 8267 10196 11595 12386 12531 12089 10938 9187 6826 4120 1124 -1933 -4946 -769 9 -10138 -12005 -13244 -13719 -13418 -12384 -10706 -8485 -5808 -2796 421 3640 6629 9344 11524 13121 14054 14261 13735 12528 10643 8209 5307 2125 -1265 -4592 -7693 -10426 -12683 -14290 -15200 -15273 -14514 -12881 -10583 -7628 -4171 -448 3303 6911 10154 12921 14914 16133 16383 15750 14259 12040 9164 5772 2083 -1721 -5395 -8751 -11629 -13799 -15261 -15758 -15399 -14104 -11989 -9176 -5801 -2022 1844 5593 9006 11905 14064 15405 15842 15387 13957 11834 9005 5754 2215 -1402 -4888 -8044 -10744 -12739 -14054 -14519 -14216 -13070 -11186 -8680 -5729 -2501 789 4023 6924 9450 11320 12489 12920 12629 11614 9949 7764 5214 2411 -495 -3327 -5845 -8006 -9690 -10820 -11288 -11133 -10271 -8914 -6992 -4820 -2357 174 2643 4910 6853 8361 9360 9729 9537 8811 7573 5908 3939 1799 -448 -2695 -4641 -6343 -7628 -8525 -8926 -8785 -8177 -7118 -5640 -3861 -1943 43 2047 3813 5332 6502 7292 7601 7455 6837 5872 4578 3054 1305 -482 -2228 -3781 -5133 -6187 -6850 -7136 -7039 -6529 -5688 -4489 -3071 -1489 109 1726 3166 4 447 5398 6034 6235 6151 5651 4847 3747 2483 997 -464 -1915 -3221 -4323 -5159 -5708 -5929 -5812 -5328 -4601 -3635 -2478 -1165 75 1324 2432 3366 4011 4423 4557 4439 3961 3326 2470 1494 422 -616 -1596 -2506 -3267 -3797 -4124 -4258 -4142 -3740 -3235 -2527 -1702 -832 43 919 1718 2391 2820 3151 3276 3206 2988 2569 1983 1321 587 -125 -837 -1516 -2112 -2554 -2854 -2951 -2883 -2669 -2285 -1771 -1186 -539 119 779 1363 1889 2223 2457 2528 2451 2177 1776 1271 681 88 -500 -1079 -1592 -2009 -2283 -2420 -2354 -2230 -1904 -1460 -942 -385 198 766 1263 1660 1967 2138 2185 2094 1889 1518 1102 577 56 -463 -971 -1423 -1799 -2070 -2222 -2244 -2112 -1910 -1554 -1166 -679 -162 353 797 1195 1505 1733 1844 1863 1696 1489 1144 731 267 -201 -706 -1157 -1525 -1834 -2036 -2089 -2033 -1893 -1644 -1281 -865 -367 85 572 968 1342 1591 1783 1812 1699 1481 1186 811 413 -66 -534 -965 -1333 -1699 -1920 -2046 -2022 -1964 -1721 -1410 -989 -505 -14 471 929 1337 1673 1863 1989 1993 1854 1634 1318 898 477 -50 -484 -940 -1320 -1657 -1852 -1978 -1928 -1778 -1531 -1199 -785 -316 174 634 1092 1470 1789 2022 2107 2081 1999 1715 1374 939 488 -27 -493 -953 -1326 -1644 -1880 -1997 -1960 -1875 -1639 -1345 -927 -511 -85 342 834 1202 1570 1801 1938 1989 1893 1721 1436 1068 663 216 -185 -632 -1040 -1384 -1625 -1783 -1857 -1836 -1659 -1466 -1131 -748 -359 46 476 852 1200 1445 1600 1678 1710 1544 1297 1003 676 246 -175 -621 -990 -1353 -1628 -1855 -1947 -1965 -1851 -1639 -1341 -973 -524 -106 376 776 1160 1492 1715 1815 1838 1738 1589 1279 979 559 106 -285 -731 -1128 -1450 -1731 -1922 -2001 -2005 -1863 -1636 -1316 -948 -545 -137 306 755 1126 1466 1717 1893 1955 1915 1760 1531 1190 844 384 -61 -511 -921 -1299 -1584 -1773 -1889 -1880 -1730 -1520 -1152 -716 -256 156 622 1057 1437 1709 1873 1925 1902 1718 1431 1103 706 272 -164 -563 -915 -1224 -1450 -1592 -1642 -1596 -1441 -1194 -879 -527 -133 274 705 1015 1294 1515 1610 1671 1592 1412 1195 876 556 214 -153 -495 -800 -1037 -1189 -1307 -1308 -1260 -1087 -879 -626 -335 8 32 1 651 900 1137 1299 1402 1387 1341 1165 950 689 388 50 -266 -572 -823 -1028 -1203 -1287 -1265 -1197 -1052 -847 -539 -253 72 411 708 976 1236 1404 1470 1433 1350 1181 965 679 366 71 -217 -547 -789 -971 -1039 -1082 -1008 -884 -726 -476 -185 104 403 697 939 1097 1232 1247 1257 1124 955 756 534 224 -38 -332 -537 -731 -889 -981 -992 -937 -839 -747 -547 -324 -111 116 343 547 724 847 924 910 902 777 676 482 301 85 -104 -272 -445 -597 -702 -779 -782 -800 -766 -653 -500 -390 -187 -59 114 259 417 508 603 643 676 626 572 463 366 200 54 -119 -237 -398 -501 -637 -698 -731 -722 -714 -624 -519 -369 -246 -82 54 248 372 492 540 592 589 526 426 358 211 56 -90 -206 -372 -476 -592 -640 -666 -661 -598 -487 -367 -211 -66 151 290 430 526 663 695 753 719 724 629 563 430 300 153 20 -85 -158 -251 -296 -309 -301 -269 -217 -153 -51 33 151 230 345 429 495 527 558 568 572 508 421 321 240 111 43 -114 -175 -232 -267 -288 -305 -300 -214 -180 -79 4 104 206 324 403 511 555 580 585 618 563 498 458 382 308 279 198 148 108 95 51 51 50 66 91 104 116 162 183 214 195 253 261 274 279 267 266 285 266 285 254 258 254 243 269 235 180 175 154 179 159 119 164 216 227 274 314 371 398 461 495 532 509 485 498 401 325 271 164 100 -27 -116 -166 -204 -230 -227 -222 -166 -106 -4 127 258 364 485 577 663 708 753 743 718 608 547 440 298 188 75 -71 -153 -204 -227 -246 -208 -198 -140 -85 43 137 254 343 438 524 593 610 631 605 572 511 456 338 250 154 62 -17 -33 -103 -77 -114 -69 -38 59 117 193 288 369 390 429 438 456 408 353 303 235 140 80 -29 -95 -164 -192 -208 -185 -166 -119 -58 95 198 288 371 488 519 563 598 582 547 482 387 277 112 4 -132 -179 -319 -376 -447 -416 -416 -382 -298 -169 -80 69 211 364 490 624 718 774 789 811 768 721 601 509 384 271 154 33 -95 -138 -216 -259 -253 -237 -198 -171 -109 -22 56 167 264 374 450 530 551 584 595 553 500 458 348 275 146 51 -62 -166 -201 -254 -295 -266 -253 -164 -137 -59 11 98 214 343 403 514 550 603 632 593 543 509 405 337 196 111 17 -61 -146 -188 -242 -229 -224 -201 -187 -129 -1 04 -37 77 112 166 237 275 311 292 292 290 235 162 111 43 4 -59 -72 -124 -140 -140 -117 -108 -61 -24 56 109 158 169 240 264 284 292 275 266 256 185 124 109 64 1 -41 -72 -87 -80 -77 -46 -35 -11 41 43 56 69 101 116 119 133 108 51 56 53 59 9 43 32 67 95 104 109 150 167 171 183 204 213 190 171 172 122 130 98 95 30 16 -20 -46 -88 -83 -74 -56 -19 33 85 119 201 272 279 319 342 364 369 376 335 325 282 213 158 108 8 -30 -116 -130 -169 -182 -164 -140 -137 -82 -54 32 116 175 225 284 317 379 369 377 342 314). ! Item was changed: + ----- Method: TwoWayScrollPane>>fitContents (in category 'layout') ----- - ----- Method: TwoWayScrollPane>>fitContents (in category 'geometry') ----- fitContents "Adjust my size to fit my contents reasonably snugly" self extent: scroller submorphBounds extent + (yScrollBar width @ xScrollBar height) + (self borderWidth*2) ! Item was changed: + ----- Method: ZASMCameraMarkMorph>>cameraController (in category 'camera') ----- - ----- Method: ZASMCameraMarkMorph>>cameraController (in category 'as yet unclassified') ----- cameraController ^(self valueOfProperty: #cameraController)! Item was changed: + ----- Method: ZASMCameraMarkMorph>>cameraPoint:cameraScale:controller: (in category 'camera') ----- - ----- Method: ZASMCameraMarkMorph>>cameraPoint:cameraScale:controller: (in category 'as yet unclassified') ----- cameraPoint: aPoint cameraScale: aNumber controller: aController self setProperty: #cameraPoint toValue: aPoint. self setProperty: #cameraScale toValue: aNumber. self setProperty: #cameraController toValue: aController. self addMorph: ( StringMorph contents: aPoint printString,' ',(aNumber printShowingMaxDecimalPlaces: 3) ) lock.! Item was changed: + ----- Method: ZASMCameraMarkMorph>>cameraPoint:cameraScale:controller:page: (in category 'camera') ----- - ----- Method: ZASMCameraMarkMorph>>cameraPoint:cameraScale:controller:page: (in category 'as yet unclassified') ----- cameraPoint: aPoint cameraScale: aNumber controller: aController page: aBookPage self setProperty: #cameraPoint toValue: aPoint. self setProperty: #cameraScale toValue: aNumber. self setProperty: #cameraController toValue: aController. self setProperty: #bookPage toValue: aBookPage. self addMorphBack: (ImageMorph new image: (aBookPage imageForm scaledToSize: 80@80)) lock. self setBalloonText: aPoint rounded printString,' ',(aNumber printShowingMaxDecimalPlaces: 3)! Item was changed: + ----- Method: ZASMCameraMarkMorph>>gotoMark (in category 'camera') ----- - ----- Method: ZASMCameraMarkMorph>>gotoMark (in category 'as yet unclassified') ----- gotoMark self cameraController turnToPage: (self valueOfProperty: #bookPage) position: (self valueOfProperty: #cameraPoint) scale: (self valueOfProperty: #cameraScale) transition: (self valueOfProperty: #transitionSpec). self setCameraValues. ! Item was changed: + ----- Method: ZASMCameraMarkMorph>>menuPageVisualFor:event: (in category 'menu') ----- - ----- Method: ZASMCameraMarkMorph>>menuPageVisualFor:event: (in category 'as yet unclassified') ----- menuPageVisualFor: target event: evt | tSpec menu | tSpec := self valueOfProperty: #transitionSpec ifAbsent: [ (self valueOfProperty: #bookPage) valueOfProperty: #transitionSpec ifAbsent: [{ 'silence' . #none. #none}] ]. menu := (MenuMorph entitled: 'Choose an effect (it is now ' , tSpec second , ')') defaultTarget: self. TransitionMorph allEffects do: [:effect | | directionChoices subMenu | directionChoices := TransitionMorph directionsForEffect: effect. directionChoices isEmpty ifTrue: [menu add: effect target: self selector: #setProperty:toValue: argumentList: (Array with: #transitionSpec with: (Array with: tSpec first with: effect with: #none))] ifFalse: [subMenu := MenuMorph new. directionChoices do: [:dir | subMenu add: dir target: self selector: #setProperty:toValue: argumentList: (Array with: #transitionSpec with: (Array with: tSpec first with: effect with: dir))]. menu add: effect subMenu: subMenu]]. menu popUpEvent: evt in: self world! Item was changed: + ----- Method: ZASMCameraMarkMorph>>setCameraValues (in category 'camera') ----- - ----- Method: ZASMCameraMarkMorph>>setCameraValues (in category 'as yet unclassified') ----- setCameraValues | camera | camera := self cameraController. "ick... since one may fail to fully take due to constraints, retry" 2 timesRepeat: [ camera cameraPoint: (self valueOfProperty: #cameraPoint). camera cameraScale: (self valueOfProperty: #cameraScale). ]. ! Item was changed: + ----- Method: ZASMCameraMarkMorph>>setTransition: (in category 'menu') ----- - ----- Method: ZASMCameraMarkMorph>>setTransition: (in category 'as yet unclassified') ----- setTransition: evt | tSpec menu | tSpec := self valueOfProperty: #transitionSpec ifAbsent: [ (self valueOfProperty: #bookPage) valueOfProperty: #transitionSpec ifAbsent: [{ 'silence' . #none. #none}] ]. menu := (MenuMorph entitled: 'Choose an effect (it is now ' , tSpec second , ')') defaultTarget: self. TransitionMorph allEffects do: [:effect | | subMenu directionChoices | directionChoices := TransitionMorph directionsForEffect: effect. directionChoices isEmpty ifTrue: [menu add: effect target: self selector: #setProperty:toValue: argumentList: (Array with: #transitionSpec with: (Array with: tSpec first with: effect with: #none))] ifFalse: [subMenu := MenuMorph new. directionChoices do: [:dir | subMenu add: dir target: self selector: #setProperty:toValue: argumentList: (Array with: #transitionSpec with: (Array with: tSpec first with: effect with: dir))]. menu add: effect subMenu: subMenu]]. menu popUpEvent: evt in: self world! Item was changed: + ----- Method: ZASMScriptMorph>>compileScript (in category 'script compiling') ----- - ----- Method: ZASMScriptMorph>>compileScript (in category 'as yet unclassified') ----- compileScript | newScript prevMark prevSteps | self fixup. newScript := OrderedCollection new. prevMark := prevSteps := nil. submorphs do: [ :each | | data | (each isKindOf: ZASMCameraMarkMorph) ifTrue: [ prevMark ifNotNil: [ data := Dictionary new. data at: #steps put: prevSteps; at: #startPoint put: (prevMark valueOfProperty: #cameraPoint); at: #endPoint put: (each valueOfProperty: #cameraPoint); at: #startZoom put: (prevMark valueOfProperty: #cameraScale); at: #endZoom put: (each valueOfProperty: #cameraScale). newScript add: data. ]. prevMark := each. ]. (each isKindOf: ZASMStepsMorph) ifTrue: [ prevSteps := each getStepCount. ]. ]. ^newScript ! Item was changed: + ----- Method: ZASMScriptMorph>>decompileScript:named:for: (in category 'script compiling') ----- - ----- Method: ZASMScriptMorph>>decompileScript:named:for: (in category 'as yet unclassified') ----- decompileScript: aScript named: aString for: aController | newMorphs prevPt prevScale | self removeAllMorphs. self setProperty: #cameraController toValue: aController. self setProperty: #cameraScriptName toValue: aString. newMorphs := OrderedCollection new. prevPt := prevScale := nil. aScript do: [ :each | | cameraPoint mark cameraScale | cameraPoint := each at: #startPoint ifAbsent: [nil]. cameraScale := each at: #startZoom ifAbsent: [nil]. (prevPt = cameraPoint and: [prevScale = cameraScale]) ifFalse: [ mark := ZASMCameraMarkMorph new. mark cameraPoint: cameraPoint cameraScale: cameraScale controller: aController. newMorphs add: mark. ]. newMorphs add: (ZASMStepsMorph new setStepCount: (each at: #steps ifAbsent: [10])). cameraPoint := each at: #endPoint ifAbsent: [nil]. cameraScale := each at: #endZoom ifAbsent: [nil]. mark := ZASMCameraMarkMorph new. mark cameraPoint: cameraPoint cameraScale: cameraScale controller: aController. newMorphs add: mark. prevPt := cameraPoint. prevScale := cameraScale. ]. self addAllMorphs: newMorphs. ! Item was changed: + ----- Method: ZASMScriptMorph>>fixup (in category 'private') ----- - ----- Method: ZASMScriptMorph>>fixup (in category 'as yet unclassified') ----- fixup | newMorphs state fixed | somethingChanged := false. newMorphs := OrderedCollection new. state := #new. fixed := false. submorphs do: [ :each | (each isKindOf: ZASMCameraMarkMorph) ifTrue: [ state == #mark ifTrue: [ newMorphs add: ( ZASMStepsMorph new setStepCount: 10 ). fixed := true. ]. newMorphs add: each. state := #mark. ]. (each isKindOf: ZASMStepsMorph) ifTrue: [ state == #steps ifTrue: [ fixed := true. ] ifFalse: [ newMorphs add: each. state := #steps. ]. ]. ]. fixed ifTrue: [ self removeAllMorphs. self addAllMorphs: newMorphs. ].! Item was changed: + ----- Method: ZASMScriptMorph>>saveScript (in category 'menus') ----- - ----- Method: ZASMScriptMorph>>saveScript (in category 'as yet unclassified') ----- saveScript | newScript scriptName | newScript := self compileScript. scriptName := UIManager default request: 'Name this script' initialAnswer: (self valueOfProperty: #cameraScriptName ifAbsent: ['']). scriptName isEmptyOrNil ifTrue: [^self]. (self valueOfProperty: #cameraController) saveScript: newScript as: scriptName. self delete.! Item was changed: + ----- Method: ZoomAndScrollControllerMorph>>cameraPoint (in category 'accessing') ----- - ----- Method: ZoomAndScrollControllerMorph>>cameraPoint (in category 'as yet unclassified') ----- cameraPoint target ifNil: [^0@0]. ^target cameraPoint ! Item was changed: + ----- Method: ZoomAndScrollControllerMorph>>cameraPoint: (in category 'accessing') ----- - ----- Method: ZoomAndScrollControllerMorph>>cameraPoint: (in category 'as yet unclassified') ----- cameraPoint: aPoint target ifNil: [^self]. target cameraPoint: aPoint! Item was changed: + ----- Method: ZoomAndScrollControllerMorph>>cameraPointRounded (in category 'accessing') ----- - ----- Method: ZoomAndScrollControllerMorph>>cameraPointRounded (in category 'as yet unclassified') ----- cameraPointRounded ^self cameraPoint rounded! Item was changed: + ----- Method: ZoomAndScrollControllerMorph>>cameraScale (in category 'accessing') ----- - ----- Method: ZoomAndScrollControllerMorph>>cameraScale (in category 'as yet unclassified') ----- cameraScale target ifNil: [^1.0]. ^target scale ! Item was changed: + ----- Method: ZoomAndScrollControllerMorph>>cameraScale: (in category 'accessing') ----- - ----- Method: ZoomAndScrollControllerMorph>>cameraScale: (in category 'as yet unclassified') ----- cameraScale: aNumber target ifNil: [^self]. target changeScaleTo: aNumber! Item was changed: + ----- Method: ZoomAndScrollControllerMorph>>changeKeys (in category 'menus') ----- - ----- Method: ZoomAndScrollControllerMorph>>changeKeys (in category 'as yet unclassified') ----- changeKeys upDownCodes := Dictionary new. changeKeysState := #(up down in out). self changed.! Item was changed: + ----- Method: ZoomAndScrollControllerMorph>>currentCameraVersion (in category 'constants') ----- - ----- Method: ZoomAndScrollControllerMorph>>currentCameraVersion (in category 'as yet unclassified') ----- currentCameraVersion ^2! Item was changed: + ----- Method: ZoomAndScrollControllerMorph>>deadZoneWidth (in category 'constants') ----- - ----- Method: ZoomAndScrollControllerMorph>>deadZoneWidth (in category 'as yet unclassified') ----- deadZoneWidth ^8 ! Item was changed: + ----- Method: ZoomAndScrollControllerMorph>>doProgrammedMoves (in category 'stepping and presenter') ----- - ----- Method: ZoomAndScrollControllerMorph>>doProgrammedMoves (in category 'as yet unclassified') ----- doProgrammedMoves | thisMove startPoint endPoint startZoom endZoom newScale newPoint fractionLeft | programmedMoves isEmptyOrNil ifTrue: [ ^programmedMoves := nil ]. thisMove := programmedMoves first. thisMove at: #pauseTime ifPresent: [ :ignore | ^self]. fractionLeft := self fractionLeftInMove: thisMove. fractionLeft ifNil: [^programmedMoves := programmedMoves allButFirst]. startPoint := thisMove at: #startPoint ifAbsentPut: [self cameraPoint]. endPoint := thisMove at: #endPoint ifAbsentPut: [self cameraPoint]. startZoom := thisMove at: #startZoom ifAbsentPut: [self cameraScale]. endZoom := thisMove at: #endZoom ifAbsentPut: [self cameraScale]. newScale := endZoom - (endZoom - startZoom * fractionLeft). newPoint := (endPoint - (endPoint - startPoint * fractionLeft)) "rounded". target changeScaleTo: newScale. target cameraPoint: newPoint. fractionLeft <= 0 ifTrue: [^programmedMoves := programmedMoves allButFirst]. ! Item was changed: + ----- Method: ZoomAndScrollControllerMorph>>editAScript (in category 'menus') ----- - ----- Method: ZoomAndScrollControllerMorph>>editAScript (in category 'as yet unclassified') ----- editAScript | d names reply s | d := self targetScriptDictionary. names := d keys asArray sort. reply := UIManager default chooseFrom: names values: names title: 'Script to edit?'. reply ifNil: [^ self]. (s := ZASMScriptMorph new) decompileScript: (d at: reply) named: reply for: self; fullBounds; align: s center with: self center; openInWorld ! Item was changed: + ----- Method: ZoomAndScrollControllerMorph>>fractionLeftInMove: (in category 'private') ----- - ----- Method: ZoomAndScrollControllerMorph>>fractionLeftInMove: (in category 'as yet unclassified') ----- fractionLeftInMove: thisMove | steps stepsRemaining fractionLeft endTime startTime | (thisMove includesKey: #steps) ifTrue: [ steps := thisMove at: #steps ifAbsentPut: [1]. stepsRemaining := thisMove at: #stepsRemaining ifAbsentPut: [steps]. stepsRemaining < 1 ifTrue: [^nil]. stepsRemaining := stepsRemaining - 1. fractionLeft := stepsRemaining / steps. thisMove at: #stepsRemaining put: stepsRemaining. ] ifFalse: [ endTime := thisMove at: #endTime ifAbsent: [^nil]. startTime := thisMove at: #startTime ifAbsent: [^nil]. fractionLeft := (endTime - Time millisecondClockValue) / (endTime - startTime). ]. ^fractionLeft max: 0 ! Item was changed: + ----- Method: ZoomAndScrollControllerMorph>>grabCameraPositionEvent:morph: (in category 'camera') ----- - ----- Method: ZoomAndScrollControllerMorph>>grabCameraPositionEvent:morph: (in category 'as yet unclassified') ----- grabCameraPositionEvent: anEvent morph: aMorph | mark | mark := ZASMCameraMarkMorph new. mark cameraPoint: self cameraPoint cameraScale: self cameraScale controller: self page: target. anEvent hand attachMorph: mark.! Item was changed: + ----- Method: ZoomAndScrollControllerMorph>>patchOldVersion1 (in category 'private') ----- - ----- Method: ZoomAndScrollControllerMorph>>patchOldVersion1 (in category 'as yet unclassified') ----- patchOldVersion1 "hack.. use this as an opportunity to fix old versions" self allMorphsDo: [:m | ((m isKindOf: UpdatingStringMorph) and: [m getSelector == #cameraPoint]) ifTrue: [ m getSelector: #cameraPointRounded ]. ]. ! Item was changed: + ----- Method: ZoomAndScrollControllerMorph>>pauseProgrammedMoves (in category 'piano rolls') ----- - ----- Method: ZoomAndScrollControllerMorph>>pauseProgrammedMoves (in category 'as yet unclassified') ----- pauseProgrammedMoves programmedMoves isEmptyOrNil ifTrue: [^self]. programmedMoves first at: #pauseTime put: Time millisecondClockValue ! Item was changed: + ----- Method: ZoomAndScrollControllerMorph>>resumeProgrammedMoves (in category 'piano rolls') ----- - ----- Method: ZoomAndScrollControllerMorph>>resumeProgrammedMoves (in category 'as yet unclassified') ----- resumeProgrammedMoves | thisStep | programmedMoves isEmptyOrNil ifTrue: [^self]. (thisStep := programmedMoves first) at: #pauseTime ifPresent: [ :pauseTime | thisStep at: #startTime put: (thisStep at: #startTime) + Time millisecondClockValue - pauseTime. thisStep removeKey: #pauseTime ifAbsent: []. ]. ! Item was changed: + ----- Method: ZoomAndScrollControllerMorph>>runAScript (in category 'menus') ----- - ----- Method: ZoomAndScrollControllerMorph>>runAScript (in category 'as yet unclassified') ----- runAScript | d names reply | d := self targetScriptDictionary. names := d keys asArray sort. reply := UIManager default chooseFrom: names values: names title: 'Script to run?'. reply ifNil: [^ self]. programmedMoves := (d at: reply) veryDeepCopy.! Item was changed: + ----- Method: ZoomAndScrollControllerMorph>>saveScript:as: (in category 'menus') ----- - ----- Method: ZoomAndScrollControllerMorph>>saveScript:as: (in category 'as yet unclassified') ----- saveScript: newScript as: scriptName self targetScriptDictionary at: scriptName put: newScript. ! Item was changed: + ----- Method: ZoomAndScrollControllerMorph>>setProgrammedMoves: (in category 'menus') ----- - ----- Method: ZoomAndScrollControllerMorph>>setProgrammedMoves: (in category 'as yet unclassified') ----- setProgrammedMoves: aCollection programmedMoves := aCollection ! Item was changed: + ----- Method: ZoomAndScrollControllerMorph>>target: (in category 'accessing-backstop') ----- - ----- Method: ZoomAndScrollControllerMorph>>target: (in category 'as yet unclassified') ----- target: x target := x. ! Item was changed: + ----- Method: ZoomAndScrollControllerMorph>>targetScriptDictionary (in category 'accessing') ----- - ----- Method: ZoomAndScrollControllerMorph>>targetScriptDictionary (in category 'as yet unclassified') ----- targetScriptDictionary target ifNil: [^Dictionary new]. ^target valueOfProperty: #namedCameraScripts ifAbsent: [ | scriptDict | scriptDict := Dictionary new. target setProperty: #namedCameraScripts toValue: scriptDict. scriptDict ]. ! Item was changed: + ----- Method: ZoomAndScrollControllerMorph>>turnToPage:position:scale:transition: (in category 'camera') ----- - ----- Method: ZoomAndScrollControllerMorph>>turnToPage:position:scale:transition: (in category 'as yet unclassified') ----- turnToPage: page position: aPoint scale: aNumber transition: aSpec | myBook | target == page ifTrue: [^false]. page ifNil: [^false]. myBook := (self ownerThatIsA: StoryboardBookMorph) ifNil: [^ false]. 2 timesRepeat: [ page cameraPoint: aPoint; changeScaleTo: aNumber ]. BookMorph turnOffSoundWhile: [ myBook goToPageMorph: page transitionSpec: aSpec. ]. ^true! Item was changed: + ----- Method: ZoomAndScrollMorph>>changeOffsetBy: (in category 'accessing') ----- - ----- Method: ZoomAndScrollMorph>>changeOffsetBy: (in category 'as yet unclassified') ----- changeOffsetBy: aPoint | transform rounder roundPt | "improve behavior at high magnification by rounding change to whole source pixels" transform := self myTransformMorph. rounder := [ :val | "(val abs + (transform scale * 0.99) roundTo: transform scale) * val sign" "looks like rounding wasn't a good solution" val ]. roundPt := (rounder value: aPoint x) @ (rounder value: aPoint y). self changeOffsetTo: transform offset + roundPt. ! Item was changed: + ----- Method: ZoomAndScrollMorph>>changeOffsetTo: (in category 'accessing') ----- - ----- Method: ZoomAndScrollMorph>>changeOffsetTo: (in category 'as yet unclassified') ----- changeOffsetTo: aPoint | transform trialOffset innerPasteup keepWidth keepHeight | transform := self myTransformMorph. keepWidth := transform width "// 4". keepHeight := transform height "// 4". innerPasteup := transform firstSubmorph. trialOffset := aPoint. trialOffset := (trialOffset x min: (innerPasteup width * transform scale) - keepWidth max: keepWidth - transform width) @ (trialOffset y min: (innerPasteup height * transform scale) - keepHeight max: keepHeight - transform height). transform offset: trialOffset. ! Item was changed: + ----- Method: ZoomAndScrollMorph>>changeScaleTo: (in category 'accessing') ----- - ----- Method: ZoomAndScrollMorph>>changeScaleTo: (in category 'as yet unclassified') ----- changeScaleTo: aNumber | transform innerPasteup min1 min2 newScale oldPoint | transform := self myTransformMorph. "oldScale := transform scale." innerPasteup := transform firstSubmorph. min1 := transform width / innerPasteup width asFloat. min2 := transform height / innerPasteup height asFloat. newScale := (aNumber max: min1) max: min2. oldPoint := self cameraPoint. transform scale: newScale. self cameraPoint: oldPoint. "scaleR := newScale / oldScale. half := transform extent // 2. half := 0@0. self changeOffsetBy: scaleR * (transform offset + half) - half - transform offset." "==Alan's preferred factors pan = 0.0425531914893617 zoom = 0.099290780141844 ===" ! Item was changed: + ----- Method: ZoomAndScrollMorph>>changeTiltFactor: (in category 'accessing') ----- - ----- Method: ZoomAndScrollMorph>>changeTiltFactor: (in category 'as yet unclassified') ----- changeTiltFactor: x panAndTiltFactor := x! Item was changed: + ----- Method: ZoomAndScrollMorph>>changeZoomFactor: (in category 'accessing') ----- - ----- Method: ZoomAndScrollMorph>>changeZoomFactor: (in category 'as yet unclassified') ----- changeZoomFactor: x zoomFactor := x! Item was changed: + ----- Method: ZoomAndScrollMorph>>getTiltFactor (in category 'accessing') ----- - ----- Method: ZoomAndScrollMorph>>getTiltFactor (in category 'as yet unclassified') ----- getTiltFactor ^panAndTiltFactor ifNil: [panAndTiltFactor := 0.5]. ! Item was changed: + ----- Method: ZoomAndScrollMorph>>getZoomFactor (in category 'accessing') ----- - ----- Method: ZoomAndScrollMorph>>getZoomFactor (in category 'as yet unclassified') ----- getZoomFactor ^zoomFactor ifNil: [zoomFactor := 0.5]. ! Item was changed: + ----- Method: ZoomAndScrollMorph>>panImageBy: (in category 'transformations') ----- - ----- Method: ZoomAndScrollMorph>>panImageBy: (in category 'as yet unclassified') ----- panImageBy: pixels self changeOffsetBy: (pixels * self getTiltFactor * 0.1) @ 0. "steps := (pixels abs / 6) exp rounded * pixels sign." "==Alan's preferred factors pan = 0.0425531914893617 zoom = 0.099290780141844 ===" ! Item was changed: + ----- Method: ZoomAndScrollMorph>>scaleImageBy: (in category 'transformations') ----- - ----- Method: ZoomAndScrollMorph>>scaleImageBy: (in category 'as yet unclassified') ----- scaleImageBy: pixels | scalePerPixel steps transform factor | transform := self myTransformMorph. (steps := (pixels * self getZoomFactor * 0.2) rounded) = 0 ifTrue: [^self]. scalePerPixel := 1.01. factor := scalePerPixel raisedTo: steps abs. steps > 0 ifTrue: [ factor := 1.0 / factor. ]. self changeScaleTo: (transform scale * factor min: 10.0 max: 0.1). ! Item was changed: + ----- Method: ZoomAndScrollMorph>>tiltImageBy: (in category 'transformations') ----- - ----- Method: ZoomAndScrollMorph>>tiltImageBy: (in category 'as yet unclassified') ----- tiltImageBy: pixels self changeOffsetBy: 0 @ (pixels * self getTiltFactor * 0.1) " steps := (pixels abs / 6) exp rounded * pixels sign. " "==Alan's preferred factors pan = 0.0425531914893617 zoom = 0.099290780141844 ===" !

1 0

The Trunk: System-mt.1053.mcz
by commits＠source.squeak.org 24 Jan '19

24 Jan '19

Marcel Taeumel uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-mt.1053.mcz ==================== Summary ==================== Name: System-mt.1053 Author: mt Time: 24 January 2019, 2:13:52.854611 pm UUID: 3877b382-e5b6-634b-944f-d484544f0542 Ancestors: System-mt.1052 Found a better API for the pragma-clean-up. Accidentally removed the removal of obsolete preferences in the previous commit. Fix that, too. =============== Diff against System-mt.1052 =============== Item was changed: ----- Method: Preferences class>>cleanUp (in category 'class initialization') ----- cleanUp - "Synchronize the cache for pragma preferences. Note that the actual preferences values are stored in class variables. So, no such value gets lost if we remove all such preferences from that cache." + "Synchronize the cache for pragma preferences. Note that the actual preferences values are stored in class variables. So, no such value gets lost if we remove all such preferences from that cache." + self removeAllPreferencesSuchThat: [:preference | + preference isPragmaPreference]. - "1/2 - Remove all pragma-preference objects from the dictionary of preferences." - self atomicUpdatePreferences: [:copyOfDictionaryOfPreferences | - copyOfDictionaryOfPreferences keys do: [:key | - (copyOfDictionaryOfPreferences at: key) isPragmaPreference - ifTrue: [copyOfDictionaryOfPreferences removeKey: key]]]. - - "2/2 - Re-create all those pragma-preference objects." SystemNavigation default allSelectorsAndMethodsDo: [:behavior :selector :method | + method pragmas do: [:pragma | + self addPragmaPreference: pragma]]. + + "Remove obsolete (non-pragma) preferences." + self removeObsolete. + ! - method pragmas do: [:pragma | self addPragmaPreference: pragma]].!

1 0

The Trunk: System-mt.1052.mcz
by commits＠source.squeak.org 24 Jan '19

24 Jan '19

Marcel Taeumel uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-mt.1052.mcz ==================== Summary ==================== Name: System-mt.1052 Author: mt Time: 24 January 2019, 2:05:11.02266 pm UUID: 6db55eef-6153-0949-b109-6cf5ab454a91 Ancestors: System-mt.1051 Synchronize preference cache for pragma-preferences on clean-up. For example, the 5.2 release misses the "sort message categories alphabetically" entry in our Preference Browser. =============== Diff against System-mt.1051 =============== Item was added: + ----- Method: PragmaPreference>>isPragmaPreference (in category 'testing') ----- + isPragmaPreference + + ^ true! Item was added: + ----- Method: Preference>>isPragmaPreference (in category 'testing') ----- + isPragmaPreference + + ^ false! Item was changed: + ----- Method: Preferences class>>cleanUp (in category 'class initialization') ----- - ----- Method: Preferences class>>cleanUp (in category 'initialization') ----- cleanUp + "Synchronize the cache for pragma preferences. Note that the actual preferences values are stored in class variables. So, no such value gets lost if we remove all such preferences from that cache." + + "1/2 - Remove all pragma-preference objects from the dictionary of preferences." + self atomicUpdatePreferences: [:copyOfDictionaryOfPreferences | + copyOfDictionaryOfPreferences keys do: [:key | + (copyOfDictionaryOfPreferences at: key) isPragmaPreference + ifTrue: [copyOfDictionaryOfPreferences removeKey: key]]]. + + "2/2 - Re-create all those pragma-preference objects." + SystemNavigation default allSelectorsAndMethodsDo: [:behavior :selector :method | + method pragmas do: [:pragma | self addPragmaPreference: pragma]].! - self removeObsolete.!

1 0

The Trunk: Chronology-Tests-pre.17.mcz
by commits＠source.squeak.org 23 Jan '19

23 Jan '19

Patrick Rein uploaded a new version of Chronology-Tests to project The Trunk: http://source.squeak.org/trunk/Chronology-Tests-pre.17.mcz ==================== Summary ==================== Name: Chronology-Tests-pre.17 Author: pre Time: 23 January 2019, 4:10:44.817474 pm UUID: 1b42bb75-6b0c-024f-b3c1-0d04823785bd Ancestors: Chronology-Tests-pre.16 Updates testWait to use the standard library constructor for millisecond Durations =============== Diff against Chronology-Tests-pre.16 =============== Item was changed: ----- Method: DurationTest>>testWait (in category 'tests') ----- testWait | start | start := DateAndTime new. + (Duration milliSeconds: 500) wait. + self assert: DateAndTime now - start > (Duration milliSeconds: 500). ! - (Duration milliseconds: 500) wait. - self assert: DateAndTime now - start > (Duration milliseconds: 500). !

1 0

The Trunk: Chronology-Tests-pre.16.mcz
by commits＠source.squeak.org 23 Jan '19

23 Jan '19

Patrick Rein uploaded a new version of Chronology-Tests to project The Trunk: http://source.squeak.org/trunk/Chronology-Tests-pre.16.mcz ==================== Summary ==================== Name: Chronology-Tests-pre.16 Author: pre Time: 23 January 2019, 4:07:30.393474 pm UUID: 0802f65d-2dc0-6e44-b8ec-b8b6428edacb Ancestors: Chronology-Tests-ul.15, Chronology-Tests-dtl.15 - adds the DateAndTimeTest>>#testGetSeconds test from dtl - adds a test for Duration>>#wait - updates an old test to match the new API #testNew - recategorizes the tests into the tests category =============== Diff against Chronology-Tests-ul.15 =============== Item was added: + ----- Method: DateAndTimeTest>>testGetSeconds (in category 'Tests') ----- + testGetSeconds + "Verify that getSeconds represents whole seconds in the local time zone. For + a given instance of DateAndTime, changing the time zone offset changes the + local representation, but does not affect magnitude (time since a defiined + epoch). Therefore, if time zone offset changes, the asSeconds value should + not change, and the getSeconds value should change to reflect local timezone." + + | dt s1 id stSeconds seconds1 seconds2 | + s1 := '2019-01-12T10:07:05.18743-05:00'. + dt := s1 asDateAndTime. + self assert: 18000 seconds negated equals: dt offset. + seconds1 := dt getSeconds. + self assert: 36425 equals: seconds1. + id := dt identityHash. + stSeconds := dt asSeconds. + dt makeUTC. "make the receiver's timezone GMT, do not change magnitude" + self assert: id equals: dt identityHash. "same object, not a copy" + self assert: '2019-01-12T15:07:05.18743+00:00' equals: dt asString. + self assert: stSeconds equals: dt asSeconds. "magnitude unchanged" + self assert: '2019-01-12T10:07:05.18743-05:00' asDateAndTime equals: dt. "still equal" + seconds2 := dt getSeconds. + self deny: seconds1 equals: seconds2. + self assert: 54425 equals: seconds2. + + ! Item was changed: + ----- Method: DurationTest>>classToBeTested (in category 'coverage') ----- - ----- Method: DurationTest>>classToBeTested (in category 'Coverage') ----- classToBeTested ^ Duration ! Item was changed: + ----- Method: DurationTest>>selectorsToBeIgnored (in category 'coverage') ----- - ----- Method: DurationTest>>selectorsToBeIgnored (in category 'Coverage') ----- selectorsToBeIgnored | private | private := #( #printOn: ). ^ super selectorsToBeIgnored, private ! Item was changed: + ----- Method: DurationTest>>testAbs (in category 'tests') ----- - ----- Method: DurationTest>>testAbs (in category 'testing') ----- testAbs self assert: aDuration abs = aDuration. self assert: (Duration nanoSeconds: -5) abs = (Duration nanoSeconds: 5). ! Item was changed: + ----- Method: DurationTest>>testAgo (in category 'tests') ----- - ----- Method: DurationTest>>testAgo (in category 'testing') ----- testAgo self assert: ((10 minutes ago) isMemberOf: DateAndTime). self assert: ((10 weeks ago) < DateAndTime now). self assert: ((-50 seconds ago) > DateAndTime now). self assert: ((10 hours ago) < DateAndTime now). self assert: (0 seconds ago - DateAndTime now < 1 second).! Item was changed: + ----- Method: DurationTest>>testAsDelay (in category 'tests') ----- - ----- Method: DurationTest>>testAsDelay (in category 'testing') ----- testAsDelay self deny: aDuration asDelay = aDuration. "want to come up with a more meaningful test" ! Item was changed: + ----- Method: DurationTest>>testAsDuration (in category 'tests') ----- - ----- Method: DurationTest>>testAsDuration (in category 'testing') ----- testAsDuration self assert: aDuration asDuration = aDuration ! Item was changed: + ----- Method: DurationTest>>testAsMilliSeconds (in category 'tests') ----- - ----- Method: DurationTest>>testAsMilliSeconds (in category 'testing') ----- testAsMilliSeconds self assert: (Duration nanoSeconds: 1000000) asMilliSeconds = 1. self assert: (Duration seconds: 1) asMilliSeconds = 1000. self assert: (Duration nanoSeconds: 1000000) asMilliSeconds = 1. self assert: (Duration nanoSeconds: 1000000) asMilliSeconds = 1. self assert: aDuration asMilliSeconds = 93784000. self assert: (Duration milliSeconds: 3775) asSeconds = 3. self assert: (Duration milliSeconds: 3775) nanoSeconds = 775000000! Item was changed: + ----- Method: DurationTest>>testAsNanoSeconds (in category 'tests') ----- - ----- Method: DurationTest>>testAsNanoSeconds (in category 'testing') ----- testAsNanoSeconds self assert: (Duration nanoSeconds: 1) asNanoSeconds = 1. self assert: (Duration seconds: 1) asNanoSeconds = 1000000000. self assert: aDuration asNanoSeconds = 93784000000005.! Item was changed: + ----- Method: DurationTest>>testAsSeconds (in category 'tests') ----- - ----- Method: DurationTest>>testAsSeconds (in category 'testing') ----- testAsSeconds self assert: (Duration nanoSeconds: 1000000000) asSeconds = 1. self assert: (Duration seconds: 1) asSeconds = 1. self assert: aDuration asSeconds = 93784.! Item was changed: + ----- Method: DurationTest>>testComparing (in category 'tests') ----- - ----- Method: DurationTest>>testComparing (in category 'Tests') ----- testComparing | d1 d2 d3 | d1 := Duration seconds: 10 nanoSeconds: 1. d2 := Duration seconds: 10 nanoSeconds: 1. d3 := Duration seconds: 10 nanoSeconds: 2. self assert: (d1 = d1); assert: (d1 = d2); deny: (d1 = d3); assert: (d1 < d3) ! Item was changed: + ----- Method: DurationTest>>testDays (in category 'tests') ----- - ----- Method: DurationTest>>testDays (in category 'testing') ----- testDays self assert: aDuration days = 1. self assert: (Duration days: 1) days= 1. ! Item was changed: + ----- Method: DurationTest>>testDivide (in category 'tests') ----- - ----- Method: DurationTest>>testDivide (in category 'testing') ----- testDivide self assert: aDuration / aDuration = 1. self assert: aDuration / 2 = (Duration days: 0 hours: 13 minutes: 1 seconds: 32 nanoSeconds: 2). self assert: aDuration / (1/2) = (Duration days: 2 hours: 4 minutes: 6 seconds: 8 nanoSeconds: 10). ! Item was changed: + ----- Method: DurationTest>>testFromNow (in category 'tests') ----- - ----- Method: DurationTest>>testFromNow (in category 'testing') ----- testFromNow self assert: ((10 seconds fromNow) > DateAndTime now). self assert: ((0 days fromNow - DateAndTime now) < 1 second). self assert: ((-1 weeks fromNow) < DateAndTime now). self assert: ((1000 milliSeconds fromNow) isMemberOf: DateAndTime). self assert: ((250 hours fromNow) > DateAndTime now). self assert: ((-50 minutes fromNow) < DateAndTime now).! Item was changed: + ----- Method: DurationTest>>testFromString (in category 'tests') ----- - ----- Method: DurationTest>>testFromString (in category 'testing') ----- testFromString self assert: aDuration = (Duration fromString: '1:02:03:04.000000005'). ! Item was changed: + ----- Method: DurationTest>>testHash (in category 'tests') ----- - ----- Method: DurationTest>>testHash (in category 'testing') ----- testHash self assert: aDuration hash = (Duration days: 1 hours: 2 minutes: 3 seconds: 4 nanoSeconds: 5) hash. self assert: aDuration hash = 93789 "must be a more meaningful test?"! Item was changed: + ----- Method: DurationTest>>testHours (in category 'tests') ----- - ----- Method: DurationTest>>testHours (in category 'testing') ----- testHours self assert: aDuration hours = 2. self assert: (Duration hours: 2) hours = 2. ! Item was changed: + ----- Method: DurationTest>>testIntegerDivision (in category 'tests') ----- - ----- Method: DurationTest>>testIntegerDivision (in category 'testing') ----- testIntegerDivision self assert: aDuration // aDuration = 1. self assert: aDuration // 2 = (aDuration / 2). "is there ever a case where this is not true, since precision is always to the nano second?"! Item was changed: + ----- Method: DurationTest>>testLessThan (in category 'tests') ----- - ----- Method: DurationTest>>testLessThan (in category 'testing') ----- testLessThan self assert: aDuration < (aDuration + 1 day ). self deny: aDuration < aDuration. ! Item was changed: + ----- Method: DurationTest>>testMilliSeconds (in category 'tests') ----- - ----- Method: DurationTest>>testMilliSeconds (in category 'testing') ----- testMilliSeconds #( "argument (milliseconds) seconds nanoseconds" (5 0 5000000) (1005 1 5000000) (-5 0 -5000000) (-1005 -1 -5000000) (1234567 1234 567000000) (-1234567 -1234 -567000000) ) do: [ :each | | duration | duration := Duration milliSeconds: each first. self assert: duration asSeconds = each second. self assert: duration nanoSeconds = each third ]! Item was changed: + ----- Method: DurationTest>>testMinus (in category 'tests') ----- - ----- Method: DurationTest>>testMinus (in category 'testing') ----- testMinus self assert: aDuration - aDuration = (Duration seconds: 0). self assert: aDuration - (Duration days: -1 hours: -2 minutes: -3 seconds: -4 nanoSeconds: -5) = (Duration days: 2 hours: 4 minutes: 6 seconds: 8 nanoSeconds: 10). self assert: aDuration - (Duration days: 0 hours: 1 minutes: 2 seconds: 3 nanoSeconds: 4) = (Duration days: 1 hours: 1 minutes: 1 seconds: 1 nanoSeconds: 1). self assert: aDuration - (Duration days: 0 hours: 3 minutes: 0 seconds: 5 nanoSeconds: 0) = (Duration days: 0 hours: 23 minutes: 2 seconds: 59 nanoSeconds: 5). ! Item was changed: + ----- Method: DurationTest>>testMinutes (in category 'tests') ----- - ----- Method: DurationTest>>testMinutes (in category 'testing') ----- testMinutes self assert: aDuration minutes = 3. self assert: (Duration minutes: 3) minutes = 3. ! Item was changed: + ----- Method: DurationTest>>testModulo (in category 'tests') ----- - ----- Method: DurationTest>>testModulo (in category 'Tests') ----- testModulo | d1 d2 d3 | d1 := 11.5 seconds. d2 := d1 \\ 3. self assert: d2 = (Duration nanoSeconds: 1). d3 := d1 \\ (3 seconds). self assert: d3 = (Duration seconds: 2 nanoSeconds: 500000000). self assert: aDuration \\ aDuration = (Duration days: 0 hours: 0 minutes: 0 seconds: 0 nanoSeconds: 0). self assert: aDuration \\ 2 = (Duration days: 0 hours: 0 minutes: 0 seconds: 0 nanoSeconds: 1). ! Item was changed: + ----- Method: DurationTest>>testMonthDurations (in category 'tests') ----- - ----- Method: DurationTest>>testMonthDurations (in category 'Tests') ----- testMonthDurations | jan feb dec | jan := Duration month: #January. feb := Duration month: #February. dec := Duration month: #December. self assert: jan = (Year current months first duration); assert: feb = (Year current months second duration); assert: dec = (Year current months last duration) ! Item was changed: + ----- Method: DurationTest>>testMultiply (in category 'tests') ----- - ----- Method: DurationTest>>testMultiply (in category 'testing') ----- testMultiply self assert: aDuration * 2 = (Duration days: 2 hours: 4 minutes: 6 seconds: 8 nanoSeconds: 10). ! Item was changed: + ----- Method: DurationTest>>testNanoSeconds (in category 'tests') ----- - ----- Method: DurationTest>>testNanoSeconds (in category 'testing') ----- testNanoSeconds self assert: aDuration nanoSeconds = 5. self assert: (Duration nanoSeconds: 5) nanoSeconds = 5. ! Item was changed: + ----- Method: DurationTest>>testNegated (in category 'tests') ----- - ----- Method: DurationTest>>testNegated (in category 'testing') ----- testNegated self assert: aDuration + aDuration negated = (Duration seconds: 0). ! Item was changed: + ----- Method: DurationTest>>testNegative (in category 'tests') ----- - ----- Method: DurationTest>>testNegative (in category 'testing') ----- testNegative self deny: aDuration negative. self assert: aDuration negated negative ! Item was changed: + ----- Method: DurationTest>>testNew (in category 'tests') ----- - ----- Method: DurationTest>>testNew (in category 'testing') ----- testNew + + self assert: Duration new = (Duration seconds: 0)! - "self assert: Duration new = (Duration seconds: 0)." - "new is not valid as a creation method: MessageNotUnderstood: UndefinedObject>>quo:, where Duration seconds is nil"! Item was changed: + ----- Method: DurationTest>>testNormalizeNanoSeconds (in category 'tests') ----- - ----- Method: DurationTest>>testNormalizeNanoSeconds (in category 'testing') ----- testNormalizeNanoSeconds "Subtraction of two DateAndTime values may result in a request to create a Duration with negative nanoseconds and positive seconds. The resulting Duration should be normalized, otherwise its printString will be invalid." | d t1 t2 | t1 := '2004-01-07T11:55:01+00:00' asDateAndTime. t2 := '2004-01-07T11:55:00.9+00:00' asDateAndTime. d := t1 - t2. "100 millisecond difference" self assert: d nanoSeconds > 0. self assert: d seconds = 0. self assert: d nanoSeconds = 100000000. self assert: d asString = '0:00:00:00.1'. "Verify that other combinations produces reasonable printString values" self assert: (Duration seconds: 1 nanoSeconds: 100000000) printString = '0:00:00:01.1'. self assert: (Duration seconds: -1 nanoSeconds: -100000000) printString = '-0:00:00:01.1'. self assert: (Duration seconds: 1 nanoSeconds: -100000000) printString = '0:00:00:00.9'. self assert: (Duration seconds: -1 nanoSeconds: 100000000) printString = '-0:00:00:00.9' ! Item was changed: + ----- Method: DurationTest>>testNumberConvenienceMethods (in category 'tests') ----- - ----- Method: DurationTest>>testNumberConvenienceMethods (in category 'Tests') ----- testNumberConvenienceMethods self assert: 1 week = (Duration days: 7); assert: -1 week = (Duration days: -7); assert: 1 day = (Duration days: 1); assert: -1 day = (Duration days: -1); assert: 1 hours = (Duration hours: 1); assert: -1 hour = (Duration hours: -1); assert: 1 minute = (Duration seconds: 60); assert: -1 minute = (Duration seconds: -60); assert: 1 second = (Duration seconds: 1); assert: -1 second = (Duration seconds: -1); assert: 1 milliSecond = (Duration milliSeconds: 1); assert: -1 milliSecond = (Duration milliSeconds: -1); assert: 1 nanoSecond = (Duration nanoSeconds: 1); assert: -1 nanoSecond = (Duration nanoSeconds: -1) ! Item was changed: + ----- Method: DurationTest>>testPlus (in category 'tests') ----- - ----- Method: DurationTest>>testPlus (in category 'testing') ----- testPlus self assert: (aDuration + 0 hours) = aDuration. self assert: (aDuration + aDuration) = (Duration days: 2 hours: 4 minutes: 6 seconds: 8 nanoSeconds: 10). ! Item was changed: + ----- Method: DurationTest>>testPositive (in category 'tests') ----- - ----- Method: DurationTest>>testPositive (in category 'testing') ----- testPositive self assert: (Duration nanoSeconds: 0) positive. self assert: aDuration positive. self deny: aDuration negated positive ! Item was changed: + ----- Method: DurationTest>>testPrintOn (in category 'tests') ----- - ----- Method: DurationTest>>testPrintOn (in category 'testing') ----- testPrintOn | ref ws | ref := '1:02:03:04.000000005'. ws := '' writeStream. aDuration printOn: ws. self assert: ws contents = ref! Item was changed: + ----- Method: DurationTest>>testQuotient (in category 'tests') ----- - ----- Method: DurationTest>>testQuotient (in category 'Tests') ----- testQuotient | d1 d2 q | d1 := 11.5 seconds. d2 := d1 // 3. self assert: d2 = (Duration seconds: 3 nanoSeconds: 833333333). q := d1 // (3 seconds). self assert: q = 3. ! Item was changed: + ----- Method: DurationTest>>testReadFrom (in category 'tests') ----- - ----- Method: DurationTest>>testReadFrom (in category 'testing') ----- testReadFrom self assert: aDuration = (Duration readFrom: (ReadStream on: '1:02:03:04.000000005')) ! Item was changed: + ----- Method: DurationTest>>testReadFromTrailingDigits (in category 'tests') ----- - ----- Method: DurationTest>>testReadFromTrailingDigits (in category 'Tests') ----- testReadFromTrailingDigits "http://bugs.squeak.org/view.php?id=6764" self should: (Duration readFrom: '0:00:00:00.001 ' readStream) nanoSeconds = 1000000.! Item was changed: + ----- Method: DurationTest>>testRoundTo (in category 'tests') ----- - ----- Method: DurationTest>>testRoundTo (in category 'Tests') ----- testRoundTo self assert: ((5 minutes + 37 seconds) roundTo: (2 minutes)) = (6 minutes). self assert: (aDuration roundTo: (Duration days: 1)) = (Duration days: 1 hours: 0 minutes: 0 seconds: 0 nanoSeconds: 0). self assert: (aDuration roundTo: (Duration hours: 1)) = (Duration days: 1 hours: 2 minutes: 0 seconds: 0 nanoSeconds: 0). self assert: (aDuration roundTo: (Duration minutes: 1)) = (Duration days: 1 hours: 2 minutes: 3 seconds: 0 nanoSeconds: 0).! Item was changed: + ----- Method: DurationTest>>testSeconds (in category 'tests') ----- - ----- Method: DurationTest>>testSeconds (in category 'testing') ----- testSeconds self assert: aDuration seconds = 4. self assert: (Duration nanoSeconds: 2) seconds = 0. self assert: (Duration nanoSeconds: 999999999) seconds = 0. self assert: (Duration nanoSeconds: 1000000001) seconds = 1. self assert: (Duration seconds: 2) seconds = 2. self assert: (Duration days: 1 hours: 2 minutes: 3 seconds:4) seconds = 4. self deny: (Duration days: 1 hours: 2 minutes: 3 seconds:4) seconds = (1*24*60*60+(2*60*60)+(3*60)+4). ! Item was changed: + ----- Method: DurationTest>>testSecondsNanoSeconds (in category 'tests') ----- - ----- Method: DurationTest>>testSecondsNanoSeconds (in category 'testing') ----- testSecondsNanoSeconds self assert: (Duration seconds: 0 nanoSeconds: 5) = (Duration nanoSeconds: 5). "not sure I should include in sunit since its Private " self assert: (aDuration seconds: 0 nanoSeconds: 1) = (Duration nanoSeconds: 1). ! Item was changed: + ----- Method: DurationTest>>testStoreOn (in category 'tests') ----- - ----- Method: DurationTest>>testStoreOn (in category 'testing') ----- testStoreOn self assert: (aDuration storeOn: (WriteStream on:'')) asString ='1:02:03:04.000000005'. "storeOn: returns a duration (self) not a stream"! Item was changed: + ----- Method: DurationTest>>testTicks (in category 'tests') ----- - ----- Method: DurationTest>>testTicks (in category 'testing') ----- testTicks self assert: aDuration ticks = #(1 7384 5)! Item was changed: + ----- Method: DurationTest>>testTruncateTo (in category 'tests') ----- - ----- Method: DurationTest>>testTruncateTo (in category 'Tests') ----- testTruncateTo self assert: ((5 minutes + 37 seconds) truncateTo: (2 minutes)) = (4 minutes). self assert: (aDuration truncateTo: (Duration days: 1)) = (Duration days: 1 hours: 0 minutes: 0 seconds: 0 nanoSeconds: 0). self assert: (aDuration truncateTo: (Duration hours: 1)) = (Duration days: 1 hours: 2 minutes: 0 seconds: 0 nanoSeconds: 0). self assert: (aDuration truncateTo: (Duration minutes: 1)) = (Duration days: 1 hours: 2 minutes: 3 seconds: 0 nanoSeconds: 0).! Item was added: + ----- Method: DurationTest>>testWait (in category 'tests') ----- + testWait + + | start | + start := DateAndTime new. + (Duration milliseconds: 500) wait. + self assert: DateAndTime now - start > (Duration milliseconds: 500). ! Item was changed: + ----- Method: DurationTest>>testWeeks (in category 'tests') ----- - ----- Method: DurationTest>>testWeeks (in category 'testing') ----- testWeeks self assert: (Duration weeks: 1) days= 7. ! Item was changed: + ----- Method: DurationTest>>testZero (in category 'tests') ----- - ----- Method: DurationTest>>testZero (in category 'testing') ----- testZero self assert: (Duration zero) = (Duration seconds: 0). !

1 0

← Newer
1
2
3
4
5
6
7
8
9
Older →

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages January 2019