[squeak-dev] The Trunk: Morphic-pre.1787.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Nov 10 14:15:01 UTC 2021
Patrick Rein uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-pre.1787.mcz
==================== Summary ====================
Name: Morphic-pre.1787
Author: pre
Time: 10 November 2021, 3:14:54.221616 pm
UUID: 47110e44-c26f-8444-bc66-849696a5bc9b
Ancestors: Morphic-eem.1786
Recategorizes unclassified methods.
=============== Diff against Morphic-eem.1786 ===============
Item was changed:
+ ----- Method: ComplexProgressIndicator>>addProgressDecoration: (in category 'private') -----
- ----- Method: ComplexProgressIndicator>>addProgressDecoration: (in category 'as yet unclassified') -----
addProgressDecoration: extraParam
| f m |
targetMorph ifNil: [^self].
(extraParam isForm)
ifTrue:
[targetMorph
submorphsDo: [:mm | (mm isSketchMorph) ifTrue: [mm delete]].
f := Form extent: extraParam extent depth: extraParam depth.
extraParam displayOn: f.
m := SketchMorph withForm: f.
m align: m fullBounds leftCenter
with: targetMorph fullBounds leftCenter + (2 @ 0).
targetMorph addMorph: m.
^self].
(extraParam isString)
ifTrue:
[targetMorph
submorphsDo: [:mm | (mm isKindOf: StringMorph) ifTrue: [mm delete]].
m := StringMorph contents: extraParam translated.
m align: m fullBounds bottomCenter + (0 @ 8)
with: targetMorph bounds bottomCenter.
targetMorph addMorph: m.
^self]!
Item was changed:
+ ----- Method: ComplexProgressIndicator>>backgroundWorldDisplay (in category 'private') -----
- ----- Method: ComplexProgressIndicator>>backgroundWorldDisplay (in category 'as yet unclassified') -----
backgroundWorldDisplay
| world |
self flag: #bob. "really need a better way to do this"
"World displayWorldSafely."
"ugliness to try to track down a possible error"
world := Project current world.
[world displayWorld] ifError: [ :a :b |
| f |
stageCompleted := 999.
f := FileDirectory default fileNamed: 'bob.errors'.
f nextPutAll: a printString,' ',b printString; cr; cr.
f nextPutAll: 'worlds equal ',(formerWorld == world) printString; cr; cr.
f nextPutAll: thisContext longStack; cr; cr.
f nextPutAll: formerProcess suspendedContext longStack; cr; cr.
f close. Beeper beep.
].
!
Item was changed:
+ ----- Method: ComplexProgressIndicator>>forkProgressWatcher (in category 'private - background process') -----
- ----- Method: ComplexProgressIndicator>>forkProgressWatcher (in category 'as yet unclassified') -----
forkProgressWatcher
[
| currentWorld killTarget |
currentWorld := Project current world.
[stageCompleted < 999 and:
[formerProject == Project current and:
[formerWorld == currentWorld and:
[translucentMorph world notNil and:
[formerProcess suspendedContext notNil and:
[Project uiProcess == formerProcess]]]]]] whileTrue: [
translucentMorph setProperty: #revealTimes toValue:
{(Time millisecondClockValue - start max: 1). (estimate * newRatio max: 1)}.
translucentMorph changed.
translucentMorph owner addMorphInLayer: translucentMorph.
(Time millisecondClockValue - WorldState lastCycleTime) abs > 500 ifTrue: [
self backgroundWorldDisplay
].
(Delay forMilliseconds: 100) wait.
].
translucentMorph removeProperty: #revealTimes.
self loadingHistoryAt: 'total' add: (Time millisecondClockValue - start max: 1).
killTarget := targetMorph ifNotNil: [
targetMorph valueOfProperty: #deleteOnProgressCompletion
].
formerWorld == currentWorld ifTrue: [
translucentMorph delete.
killTarget ifNotNil: [killTarget delete].
] ifFalse: [
translucentMorph privateDeleteWithAbsolutelyNoSideEffects.
killTarget ifNotNil: [killTarget privateDeleteWithAbsolutelyNoSideEffects].
].
] forkAt: Processor lowIOPriority.!
Item was changed:
+ ----- Method: ComplexProgressIndicator>>historyCategory: (in category 'configuration') -----
- ----- Method: ComplexProgressIndicator>>historyCategory: (in category 'as yet unclassified') -----
historyCategory: aKey
History ifNil: [History := Dictionary new].
specificHistory := History
at: aKey
ifAbsentPut: [Dictionary new].
^specificHistory
!
Item was changed:
+ ----- Method: ComplexProgressIndicator>>loadingHistoryAt:add: (in category 'private') -----
- ----- Method: ComplexProgressIndicator>>loadingHistoryAt:add: (in category 'as yet unclassified') -----
loadingHistoryAt: aKey add: aNumber
(self loadingHistoryDataForKey: aKey) add: aNumber.
!
Item was changed:
+ ----- Method: ComplexProgressIndicator>>loadingHistoryDataForKey: (in category 'private') -----
- ----- Method: ComplexProgressIndicator>>loadingHistoryDataForKey: (in category 'as yet unclassified') -----
loadingHistoryDataForKey: anObject
| answer |
answer := specificHistory
at: anObject
ifAbsentPut: [OrderedCollection new].
answer size > 50 ifTrue: [
answer := answer copyFrom: 25 to: answer size.
specificHistory at: anObject put: answer.
].
^answer
!
Item was changed:
+ ----- Method: ComplexProgressIndicator>>targetMorph: (in category 'configuration') -----
- ----- Method: ComplexProgressIndicator>>targetMorph: (in category 'as yet unclassified') -----
targetMorph: aMorph
targetMorph := aMorph!
Item was changed:
+ ----- Method: ComplexProgressIndicator>>withProgressDo: (in category 'configuration') -----
- ----- Method: ComplexProgressIndicator>>withProgressDo: (in category 'as yet unclassified') -----
withProgressDo: aBlock
| safetyFactor totals trialRect delta |
Smalltalk isMorphic ifFalse: [^aBlock value].
formerProject := Project current.
formerWorld := formerProject world.
formerProcess := Processor activeProcess.
targetMorph
ifNil: [targetMorph := ProgressTargetRequestNotification signal].
targetMorph ifNil: [
trialRect := Rectangle center: Sensor cursorPoint extent: 80 at 80.
delta := trialRect amountToTranslateWithin: formerWorld bounds.
trialRect := trialRect translateBy: delta.
translucentMorph := TranslucentProgessMorph new
opaqueBackgroundColor: Color white;
bounds: trialRect;
openInWorld: formerWorld.
] ifNotNil: [
translucentMorph := TranslucentProgessMorph new
morphicLayerNumber: targetMorph morphicLayerNumber - 0.1;
bounds: targetMorph boundsInWorld;
openInWorld: targetMorph world.
].
stageCompleted := 0.
safetyFactor := 1.1. "better to guess high than low"
translucentMorph setProperty: #progressStageNumber toValue: 1.
translucentMorph hide.
totals := self loadingHistoryDataForKey: 'total'.
newRatio := 1.0.
estimate := totals size < 2 ifTrue: [
15000 "be a pessimist"
] ifFalse: [
(totals sum - totals max) / (totals size - 1 max: 1) * safetyFactor.
].
start := Time millisecondClockValue.
self forkProgressWatcher.
[
aBlock
on: ProgressInitiationException
do: [ :ex |
ex sendNotificationsTo: [ :min :max :curr |
"ignore this as it is inaccurate"
].
].
] on: ProgressNotification do: [ :note | | stageCompletedString |
translucentMorph show.
note extraParam ifNotNil:[self addProgressDecoration: note extraParam].
stageCompletedString := (note messageText findTokens: ' ') first.
stageCompleted := (stageCompletedString copyUpTo: $:) asNumber.
cumulativeStageTime := Time millisecondClockValue - start max: 1.
prevData := self loadingHistoryDataForKey: stageCompletedString.
prevData isEmpty ifFalse: [
newRatio := (cumulativeStageTime / (prevData average max: 1)) asFloat.
].
self
loadingHistoryAt: stageCompletedString
add: cumulativeStageTime.
translucentMorph
setProperty: #progressStageNumber
toValue: stageCompleted + 1.
note resume.
].
stageCompleted := 999. "we may or may not get here"
!
Item was changed:
+ ----- Method: IconicButton>>darken (in category 'ui') -----
- ----- Method: IconicButton>>darken (in category 'as yet unclassified') -----
darken
self firstSubmorph form: self darkenedForm!
Item was changed:
+ ----- Method: KeyboardBuffer>>flushKeyboard (in category 'keyboard control') -----
- ----- Method: KeyboardBuffer>>flushKeyboard (in category 'as yet unclassified') -----
flushKeyboard
eventUsed ifFalse: [^ eventUsed := true].!
Item was changed:
+ ----- Method: KeyboardBuffer>>keyboard (in category 'keyboard control') -----
- ----- Method: KeyboardBuffer>>keyboard (in category 'as yet unclassified') -----
keyboard
eventUsed ifFalse: [eventUsed := true. ^ event keyCharacter].
^ nil!
Item was changed:
+ ----- Method: KeyboardBuffer>>keyboardPeek (in category 'keyboard control') -----
- ----- Method: KeyboardBuffer>>keyboardPeek (in category 'as yet unclassified') -----
keyboardPeek
eventUsed ifFalse: [^ event keyCharacter].
^ nil!
Item was changed:
+ ----- Method: KeyboardBuffer>>startingEvent: (in category 'private') -----
- ----- Method: KeyboardBuffer>>startingEvent: (in category 'as yet unclassified') -----
startingEvent: evt
event := evt.
eventUsed := false!
Item was changed:
+ ----- Method: SVColorSelectorMorph>>extent: (in category 'geometry') -----
- ----- Method: SVColorSelectorMorph>>extent: (in category 'as yet unclassified') -----
extent: p
"Update the gradient directions."
super extent: p.
self updateGradients!
Item was removed:
- ----- Method: TextEditor>>systemNavigation (in category 'as yet unclassified') -----
- systemNavigation
- ^ SystemNavigation for: model environment!
More information about the Squeak-dev
mailing list
|