'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 25 October 2004 at 11:23:19 pm'!

ProgressMorph subclass: #MemoryUsage
    instanceVariableNames: 'prevUsage '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Hungry-FN'!


!MemoryUsage commentStamp: 'fn 10/25/2004 23:22' 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>
with a memory display patch from Jeff Sparkes <JSparkes@databeacon.com> (10/22/2004).
!


!MemoryUsage methodsFor: 'initialization' stamp: 'fn 10/25/2004 23:19'!

initLabelMorph
    ^ labelMorph _ StringMorph
                contents: ''
                font: (self fontOfPointSize: 12)! !

!MemoryUsage methodsFor: 'initialization' stamp: 'fn 10/25/2004 23:19'!
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 10/25/2004 23:17'!

step
    | total used usedNow |
    total _ Smalltalk vmParameterAt: 3.
    used _ Smalltalk vmParameterAt: 2.
    usedNow _ used / total roundTo: 0.01.
    usedNow := used / total roundTo: 0.01.
prevUsage = usedNow
ifFalse: [super step.
prevUsage := usedNow.
self done: prevUsage.
self subLabel: ((used / (1024 * 1024)) asFloat roundTo: 0.1) asString , 'M/' , ((total / (1024 * 1024)) asFloat roundTo: 0.1) asString , 'M = ' , ((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.
! !