'From Squeak3.5 of ''11 April 2003'' [latest update: #5180] on 6 August 2003 at 6:48:17 pm'!
ProgressMorph subclass: #MemoryUsage
instanceVariableNames: 'prevUsage '
classVariableNames: ''
poolDictionaries: ''
category: 'Hungry-FN'!
!MemoryUsage commentStamp: 'fn 8/6/2003 18:48' prior: 0!
A Morph to display the current VM memory used.
Do "MemoryUsage new openInWorld" or "MemoryUsage example".
author: Faried Nawaz <st@pain.hungry.com>
!
!MemoryUsage methodsFor: 'initialization' stamp: 'fn 8/6/2003 17:24'!
initLabelMorph
^ labelMorph _ StringMorph
contents: ''
font: (self fontOfPointSize: 12)! !
!MemoryUsage methodsFor: 'initialization' stamp: 'fn 8/6/2003 17:24'!
initSubLabelMorph
^ subLabelMorph _ StringMorph
contents: ''
font: (self fontOfPointSize: 8)! !
!MemoryUsage methodsFor: 'initialization' stamp: 'fn 8/6/2003 17:27'!
initialize
super initialize. self label: 'Memory Usage'! !
!MemoryUsage methodsFor: 'step' stamp: 'fn 8/6/2003 18:04'!
step
| total used usedNow |
total _ Smalltalk vmParameterAt: 3.
used _ Smalltalk vmParameterAt: 2.
usedNow _ used / total roundTo: 0.01.
prevUsage = usedNow
ifFalse: [super step.
prevUsage _ usedNow.
self done: prevUsage.
self subLabel: ((used / total roundTo: 0.001)
* 100) asString , '%']! !
!MemoryUsage methodsFor: 'step' stamp: 'fn 8/6/2003 18:05'!
stepTime
"Update every 5 seconds to avoid hogging the system."
^ 5000! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
MemoryUsage class
instanceVariableNames: ''!
!MemoryUsage class methodsFor: 'example' stamp: 'fn 8/6/2003 16:53'!
example
"MemoryUsage example"
| mem |
mem _ MemoryUsage label: 'Memory Usage'.
mem openInWorld.
^ self.
! !