"
 COPYRIGHT (c) 1992 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

StandardSystemView subclass:#MemoryMonitor
	 instanceVariableNames:'halted updateInterval updateBlock myProcess oldData newData
		freeData sumData updateIndex org maxUsed minUsed newColor
		freeColor oldColor prevFree prevOld'
	 classVariableNames:''
	 poolDictionaries:''
	 category:'Interface-Tools'
!

MemoryMonitor comment:'
Shows memory usage (oldspace + newspace). Simple, but useful.
'!

!MemoryMonitor class methodsFor:'startup'!

open 
    |m|

    m := self origin:0 @ 0 extent:(200 @ 100).

    m label:'Memory Monitor'.
    m icon:(Form fromFile:'Monitor.icon' resolution:100).
    m minExtent:(100 @ 100).

    m open.
    ^ m

    "MemoryMonitor open"
! !

!MemoryMonitor methodsFor:'drawing'!

updateDisplay
    "update picture; trigger next update"

    |hAll hOld hFree memUsed oldMemUsed newMemUsed freeMem x y half scaleChange s thisStringLen scale|

    realized ifFalse:[^ self].
    shown ifTrue:[
	oldMemUsed := ObjectMemory oldSpaceUsed.
	newMemUsed := ObjectMemory newSpaceUsed.
	freeMem := ObjectMemory freeListSpace.
	memUsed := oldMemUsed + newMemUsed.

	scaleChange := false.
	(memUsed < minUsed) ifTrue:[
	    minUsed := memUsed.
	    scaleChange := true
	].
	(memUsed - freeMem < minUsed) ifTrue:[
	    minUsed := memUsed - freeMem.
	    scaleChange := true
	].
	(memUsed > maxUsed) ifTrue:[
	    maxUsed := memUsed.
	    scaleChange := true
	].
	scaleChange ifTrue:[
	    self clear.
	    self redraw
	].

	oldData at:updateIndex put:oldMemUsed.
	newData at:updateIndex put:newMemUsed.
	freeData at:updateIndex put:freeMem.

	scale := height asFloat / (maxUsed - minUsed + 200000).

	hAll := ((memUsed - minUsed) * scale) asInteger.
	hOld := ((oldMemUsed - minUsed + 100000) * scale) asInteger.
	hFree := (freeMem * scale) asInteger.

	x := updateIndex - 1 + org.
	y := height - 1.

	self paint:newColor.
	self displayLineFromX:x y:y toX:x y:(y - hAll).

	self paint:oldColor.
	self displayLineFromX:x y:y toX:x y:(y - hOld).

	self paint:freeColor.
	self displayLineFromX:x y:y-hOld  toX:x y:(y - hOld + hFree).

	self paint:White on:Black.

	self paint:newColor.
	s := 'all ' , ((memUsed // 1024) printStringRightAdjustLen:5) , 'k '.
	self displayOpaqueString:s x:0 y:(height // 2 - font height).

	freeMem ~~ prevFree ifTrue:[
	    self paint:freeColor.
	    s := 'free' , ((freeMem // 1024) printStringRightAdjustLen:5) , 'k '.
	    self displayOpaqueString:s x:0 y:(height // 2 + font descent).
	    prevFree := freeMem.
	].

	(oldMemUsed - freeMem) ~~ prevOld ifTrue:[
	    self paint:oldColor.
	    s := 'old ' , (((oldMemUsed - freeMem) // 1024) printStringRightAdjustLen:5) , 'k '.
	    self displayOpaqueString:s x:0 y:(height // 2 + font height + (font descent * 2)).
	    prevOld := (oldMemUsed - freeMem).
	].

	(updateIndex >= (width - org)) ifTrue:[
	    half := ((width - org) // 2) // 8 * 8.
	    oldData replaceFrom:1 to:half with:oldData startingAt:(half + 1).
	    newData replaceFrom:1 to:half with:newData startingAt:(half + 1).
	    freeData replaceFrom:1 to:half with:freeData startingAt:(half + 1).

	    self catchExpose.
	    self copyFrom:self x:(half + org) y:0
			     toX:org y:0
			   width:(width - org - half) height:height.
	    self clearRectangleX:(width - half) y:0 width:(width - org - half) height:height.
	    self waitForExpose.
	    updateIndex := updateIndex - half + 1
	] ifFalse:[
	    updateIndex := updateIndex + 1
	].
    ].

    updateBlock notNil ifTrue:[
	Processor addTimedBlock:updateBlock afterSeconds:updateInterval
    ].


!

redraw
    "redraw data"

    |hAll hOld hFree memUsed oldMemUsed newMemUsed freeMem x y half scale s|

    realized ifFalse:[^ self].
    shown ifFalse:[^ self].

    "
     redraw all ...
    "
    self clipRect:nil.
    x := org.
    y := height - 1.
    scale := height asFloat / (maxUsed - minUsed + 200000).

    1 to:(updateIndex - 1) do:[:i |
	newMemUsed := (newData at:i).
	oldMemUsed := (oldData at:i).
	freeMem := freeData at:i.
	memUsed := oldMemUsed + newMemUsed.

	hAll := ((memUsed - minUsed) * scale) asInteger.
	hOld := ((oldMemUsed - minUsed + 100000) * scale) asInteger.
	hFree := (freeMem * scale) asInteger.

	self paint:newColor.
	self displayLineFromX:x y:y toX:x y:(y - hAll).

	self paint:oldColor.
	self displayLineFromX:x y:y toX:x y:(y - hOld).

	self paint:freeColor.
	self displayLineFromX:x y:y-hOld  toX:x y:(y - hOld + hFree).

	x := x + 1
    ].

    self paint:White.
    s := 'max ' , ((maxUsed // 1024) printStringRightAdjustLen:5) , 'k '.
    self displayString:s x:0 y:font ascent.
    s := 'min ' , ((minUsed // 1024) printStringRightAdjustLen:5) , 'k '.
    self displayString:s x:0 y:(height - font descent).

    prevFree := prevOld := nil.

    "
     since everything was draw, throw away other expose events
    "
    self sensor flushExposeEvents.


! !

!MemoryMonitor methodsFor:'destroying'!

destroy
    updateBlock notNil ifTrue:[
	Processor removeTimedBlock:updateBlock.
    ] ifFalse:[
	myProcess terminate.
	myProcess := nil
    ].
    super destroy
! !

!MemoryMonitor methodsFor:'events'!

keyPress:key x:x y:y
    key == $f ifTrue:[
	updateInterval := updateInterval / 2
    ].
    key == $s ifTrue:[
	updateInterval := updateInterval * 2
    ]
!

sizeChanged
    |nn no nf oldSize|

    oldSize := oldData size.
    ((width - org) == oldSize) ifTrue:[^ self].

    nn := Array new:width.
    no := Array new:width.
    nf := Array new:width.

    (nn size > oldSize) ifTrue:[
	nn replaceFrom:1 to:oldSize with:newData.
	no replaceFrom:1 to:oldSize with:oldData.
	nf replaceFrom:1 to:oldSize with:freeData
    ] ifFalse:[
	(updateIndex > nn size) ifTrue:[
	    nn replaceFrom:1 to:oldSize with:newData
		    startingAt:(updateIndex - oldSize + 1 ).
	    no replaceFrom:1 to:oldSize with:oldData
		    startingAt:(updateIndex - oldSize + 1 ).
	    nf replaceFrom:1 to:oldSize with:freeData
		    startingAt:(updateIndex - oldSize + 1 ).
	    updateIndex := oldSize - 1
	] ifFalse:[
	    nn replaceFrom:1 to:oldSize with:newData.
	    no replaceFrom:1 to:oldSize with:oldData.
	    nf replaceFrom:1 to:oldSize with:freeData
	]
    ].
    newData := nn.
    oldData := no.
    freeData := nf
! !

!MemoryMonitor methodsFor:'initialization'!

realize
    super realize.
    updateBlock notNil ifTrue:[
	Processor addTimedBlock:updateBlock afterSeconds:updateInterval.
    ] ifFalse:[
	myProcess := [
	    |d|

	    [true] whileTrue:[
		(Delay forSeconds:updateInterval) wait.
		self updateDisplay
	    ]
	] forkAt:5.
	myProcess name:'monitor update'
    ].

    newColor := newColor on:device.
    freeColor := freeColor on:device.
    oldColor := oldColor on:device.

    font := font on:device.
!

initialize
    super initialize.

    halted := false.
    updateInterval := 0.5.
    ProcessorScheduler isPureEventDriven ifTrue:[
	updateBlock := [self updateDisplay].
    ].
    oldData := Array new:1000.
    newData := Array new:1000.
    freeData := Array new:1000.

    updateIndex := 1.
    org := font widthOf:'used:9999k '.

    maxUsed := ObjectMemory bytesUsed.
    minUsed := ObjectMemory bytesUsed.
    viewBackground := Black.

    device hasColors ifTrue:[
	newColor := Color yellow.
	freeColor := Color green.
	oldColor := Color white.
    ] ifFalse:[
	newColor := Color grey:67.
	freeColor := Color grey:33.
	oldColor := Color white.
    ].

    self font:(Font family:'courier' face:'medium' style:'roman' size:10).

    "
     MemoryMonitor open
    "
! !