############################################################################
#
#	File:     mmm.icn
#
#	Subject:  Program to show allocation as a miniature "MemMon"
#
#	Author:   Clinton Jeffery
#
#	Date:     October 22, 2011
#
############################################################################
#
#   This file is in the public domain.
#
############################################################################
#
#  Displays a tiny rendition of internal heap allocation.
#
############################################################################
#
#  Requires:  Version 9 graphics
#
############################################################################
#
#  Links:   evinit, options, optwindw, typebind, colormap, wipe, xcompat
#
############################################################################
#
#  Includes:  evdefs.icn
#
############################################################################

$include "evdefs.icn"

link evinit
link options
link optwindw
link typebind
link colormap
link wipe

global Visualization, contexts
global t, sum, threesixty, wid, hei

procedure main(av)
   local c_string, lines, mymask, allocstr, blockall, sum1, sum2, row1, row2,
	Regions, c, start, sum2div4, verbose
   if *av>0 then
      EvInit(av) | stop("EvInit() can't load ",av[1])
   else
      EvInit() | stop("can't EvInit()")

   threesixty := 360 * 64
   t := options(av)
   /t["W"] := 650
   /t["H"] := 50
   &window := optwindow(t) | stop("no window")
   Visualization := &window
   contexts := itypebind(&window)
   c_string := contexts[E_String] | stop("eh?")
   / contexts[E_Tvsubs] := c_string

   wid := WAttrib("width")
   hei := WAttrib("height")
   lines := WAttrib("lines")

   mymask := AllocMask ++ cset("\360"||E_Collect||E_BlkDeAlc||E_StrDeAlc)
   allocstr := string(AllocMask)
   blockall := 0

   sum1 := 0
   sum2 := 0
   row1 := 0
   row2 := hei/2+1

   bpp := 4

   write("regions:")
   Regions := []
   every put(Regions,keyword("regions",Monitored)) do
       write("\t",image(Regions[-1]))
   pop(Regions)
   write("pixels in string region ", wid * (hei/2), " bytes ", Regions[1])
   write("bpp = ",Regions[1] / (wid * (hei/2)))
   bpp := integer(Regions[1] / (wid * (hei / 2)))

   while EvGet(mymask) do {
      if &eventcode === E_Lelem then &eventcode := E_List
      if &eventcode === (E_Telem|E_Tvtbl|E_Slots) then &eventcode := E_Table
      if &eventcode === E_Selem then &eventcode := E_Set
      if &eventcode === E_Refresh then &eventcode := E_Coexpr
      case &eventcode of {
	 E_Collect: {
	    wipe(&window)
	    sum1 := sum2 := 0
	    row1 := 0
	    row2 := hei/2+1
	    }
	 E_EndCollect: {
	    }
	 E_String: {
	    if sum1/bpp ~= (sum1+&eventvalue)/bpp then
		DrawLine(c_string,sum1/bpp,row1,(sum1+&eventvalue)/bpp,row1)
	    sum1 +:= &eventvalue
	    while sum1/bpp >= wid do {
	       sum1 -:= wid * bpp
	       row1 +:= 1
	       if row1 > hei/2 then {
		  EraseArea(0,0,wid,hei/2)
		  row1 := 0
		  }
	       DrawLine(c_string,0,row1,sum1/bpp,row1)
	       }
	    }
	 !.allocstr: {
	    c := \contexts[&eventcode] | stop("what is ",&eventcode)
	    start := sum2/bpp
	    sum2 +:= &eventvalue
	    sum2divbpp := sum2/bpp
	    DrawLine(c,start,row2,sum2divbpp,row2)
	    while sum2divbpp >= wid do {
	       sum2 -:= wid * bpp
	       sum2divbpp := sum2/bpp
	       row2 +:= 1
	       DrawLine(c,0,row2,sum2divbpp,row2)
	       }
	    }
	 default: {
	    if \verbose then write("unknown event code ",&eventcode)
	    }
	 }
      }
   until Event()
end

procedure itypebind(z)
  static t
  initial {
      t := table()
  }
  /(t[z]):=typebind(z,E_Integer||E_Real||E_Record||E_Set||E_String||E_Cset||
		    E_File||E_List||E_Null||E_Proc||E_Table,table())
#  if type(t[z][E_Proc])=="file" then close(t[z][E_Proc])
  t[z][E_Proc] := Clone(z,"fg=#999")
  return t[z]
end