#########################################################################
#
#	Name:	lstyle.icn
#
#	Title:	Lstyle, a list visualization monitor
#
#	Author:	Clinton Jeffery
#
#	Date:	5/1/92
#
#########################################################################
#
#    LStyle, short for "Life-Style" is a simple (list only at the moment)
# structure visualizer.  Currently it has no controls, and hasn't been
# tested standalone yet.  Also: I am going to use options() on this soon.
#

$include "evdefs.icn"
link evinit
link evnames
link typecolor
link typebind
link colormap
link viewlib
link options, optwindw

global
   displayheight,
   numperrow,
   rows,
   cols,
   contexts,
   gtypes,
   sizes,		# table of lists' sizes
   Views,		# table of expanded views of lists (window values)
   colwidth,
   numindices,
   unitheight,
   lastrow,
   lastcol,
   rowheight,
   vblack,
   ser2rc,
   width,
   height,
   number_active

procedure main(av)
   local lstoptions

   Views := table()
   sizes := table()
   #
   # pull off lst options (don't consume child's options in this call
   #  to options()).
   #
   lstoptions := []
   while av[1][1] == "-" do {
      put(lstoptions, pop(av))
      if lstoptions[-1] == "-f" then put(lstoptions, pop(av))
      if lstoptions[-1] == "-p" then put(lstoptions, pop(av))
      }
   t := options(lstoptions, winoptions() || "p:")
   wpos := \t["P"]

   EvInit(av) | stop("can't initialize monitoring")

   &window := optwindow(t) | stop("no window")

   displayheight := WAttrib("displayheight") - 30

   vblack := Clone(&window,"fg=white")

   maxwidth := maxheight  := 0
   contexts := itypebind(&window)
   height := WAttrib("height")
   width := WAttrib("width")

   rows := 1
   colwidth := 8
   cols := width / colwidth
   rowheight := height / rows
   unitheight := colwidth
   numindices := rowheight / unitheight
   ser2rc := table()
   names := evnames()

   number_active := 0
   lstmask := ListMask ++ cset(E_MXevent || E_EndCollect || E_TenureBlock)
   mymask := lstmask

   while EvGet(mymask, ,1) do {
      v := &eventvalue
      if type(v)=="list" then {
	 lastlist := v
	 vs := *v
	 ser := serial(v)
	 if animate := \Views[v] then {
	    size := *v
	    if sizes[v] < size then {
	       sizes[v] := size
	       if WAttrib(animate,"height") < displayheight then
		  WAttrib(animate,"lines="||size*2)
	       }
	    EraseArea(animate)
	    WAttrib(animate, "label=list_" || ser || " " || image(v))
	    vdraw("list_"||ser, v, animate, 3, 0, 0,
		  WAttrib(animate,"width"), WAttrib(animate,"height"))
	    }
	 if lastrc := \ (ser2rc[ser]) then {
	    lastrow := rcrow(lastrc)
	    lastcol := rccol(lastrc)
	    }
	 }
      case &eventcode of {
	 E_Lcreate: {
	    number_active +:= 1
	    mycol := number_active % cols
	    myrow := 1 + number_active / cols
	    if myrow > rows then {
	       rows +:= 1
	       rowheight := height / rows
	       unitheight := rowheight / numindices
		  if unitheight < 1 then {
		     unitheight := 1
		     numindices := unitheight
		     }
	       redraw("create #" || ser)
	       }
	    lastrc := ser2rc[ser] := rc(myrow, mycol)
	    lastrow := myrow
	    lastcol := mycol
	    every i := 1 to vs do {
	       plot(objcolor(v[i]), i, 0)
	       }
	    }
	 E_Lpop: {
	    if vs > 0 then {
	       every i := 2 to vs do plot(objcolor(v[i]), i-1)
	       plot(vblack, vs)
	       }
	 }
	 E_Lpull: {
	    if vs > 0 then
	       plot(vblack, vs)
	 }
	 E_Lpush: {
	    every i := 1 to vs do plot(objcolor(v[i]), i)
	    }
	 E_Lput: {
	    plot(objcolor(v[vs]), vs, 0)
	 }
	 E_Lsub: {
	    if v <= 0 then {
	       v +:= *lastlist + 1
	       }
	    plot(objcolor(lastlist[v]), v)
	    }
	 E_Lbang | E_Lrand | E_Lref: {
	 }
	 E_Disable: {
	    mymask := ''
	    }
	 E_Enable: {
	    mymask := lstmask
	    }
	 E_TenureBlock: {
	    WAttrib("label=Lst: tenure")
	    }
	 E_MXevent: {
	    case &eventvalue of {
	       &lpress: {
		  col := &x / colwidth
		  row := 1 + &y / rowheight
		  every k := key(ser2rc) do {
		     r := ser2rc[k]
		     if rcrow(r) = row & rccol(r) = col then {
			every st := structure(Monitored) do {
			   if type(st) == "list" & serial(st) = k then {
			      / (Views[st]) := vview("list_"||col, st, 4)
			      sizes[st] := *st
			      }
			   }
			}
		     }
		  }
	       &resize: {
		  width := &x
		  height := &y
		  colwidth := width / cols
		  rowheight := height / rows
		  unitheight := rowheight / numindices
		  if unitheight < 1 then {
		     unitheight := 1
		     numindices := unitheight
		     }
		  redraw("resize")
		  }
	       " ": {
		  Event()
		  }
	       "q": {
		  break
		  }
	       }
	    }
	 E_EndCollect: {
	    number_active := 0

	    every st := structure( Monitored ) do {
	       if type(st) == "list" then {
		  number_active +:= 1
		  }
	       }
	    rows := 1 + number_active / cols
	    rowheight := height / rows
	    unitheight := rowheight / numindices
	    numindices := rowheight / colwidth
	    if unitheight < 1 then {
	       unitheight := 1
	       numindices := rowheight
	       }
	    redraw("collect")
	    }
	 default: {
	    stop("don't know list code ",image(&eventcode))
	    }
	 }
      lastcode := &eventcode
      }
   WAttrib("windowlabel=Lst (finished)")
   EvTerm(&window)
end

procedure plot(w, index, del)
   local x, y, wd, ht
   if index > numindices then {
      numindices := index
      if unitheight >:= rowheight / numindices then {
	 if unitheight = 0 then {
	    unitheight := 1
	    if () ~=== "Lst: capped" then
	       WAttrib("label=Lst: capped")
	    numindices := index := rowheight
	    }
	 else
	    redraw("rescale ht "||unitheight|| " for size "||index)
	 }
      }
   /del := 40
   x := lastcol * colwidth
if index = 0 then write("eureka!")
   y := (lastrow - 1) * rowheight + (index - 1) * unitheight + 1
   wd := colwidth
   ht := unitheight
   FillRectangle(x, y, wd, ht)
   WFlush()
   delay(del)
   if wd > 3 then wd -:= 1
   if ht > 1 then ht -:= 1
   FillRectangle(w, x, y, wd, ht)
end

procedure objcolor(o)
   return contexts[type2code(type(o))]
end

procedure redraw(s)
   local x, y, wd, ht
   EraseArea()
   WAttrib("windowlabel=Lst: " || \s)
   every i := 1 to rows-1 do
      DrawLine(0, i * rowheight, width, i * rowheight)
   number_active := 0
   ser2rc := table()
   every type(L := structure( Monitored )) == "list" do {
	 number_active +:= 1
	 mycol := number_active % cols
	 myrow := 1 + number_active / cols
	 if myrow > rows then {
	    stop("must expand # of rows in redraw?")
	    }
	 ser := serial(L)
	 lastrc := ser2rc[ser] := rc(myrow, mycol) |
	    stop("fails on ",image(myrow),",",image(mycol))
	 lastrow := myrow
	 lastcol := mycol
	 vs := *L

	 wd := colwidth
	 if wd > 3 then wd -:= 1
	 ht := unitheight
	 if ht > 1 then ht -:= 1
	 every i := 1 to vs do {
	    FillRectangle(lastcol * colwidth,
			   (lastrow-1) * rowheight + (i-1) * unitheight + 1,
			   colwidth, unitheight)
	    FillRectangle(objcolor(L[i]), lastcol * colwidth,
			   (lastrow-1) * rowheight + (i-1) * unitheight + 1,
			   wd, ht)
	    }
      }
end

#
# <row, col> encodings as integers (not text row, col, but graph row, col)
#

procedure rc(row, col)
  return ishift(row , 16) + col
end

procedure rcrow(rc)
  return ishift(rc, -16)
end

procedure rccol(rc)
  return iand(rc, 65535)
end