%%%  Version = 1.1
%%
%% ControlGUI.oz
%% P2PKit Control Centre
%% Author:
%%   Kevin Glynn (glynn@info.ucl.ac.be)

functor
import
   Application
   System
   Property
   P2PKitClient at 'x-ozlib://keving/net/p2p/P2PKitClient.ozf'
   Util at 'x-ozlib://keving/lib/Util.ozf'
   QTk at 'x-oz://system/wp/QTk.ozf'
   XMLP at 'x-oz://system/xml/Parser.ozf'
   Connection
   Pickle
define


   %% Constants
   RefreshInterval = 45*1000
   DeadInterval = 120*1000

   ArrowWidth = 2
   HighlightArrowWidth = 3

   ArrowColour = black
   HighlightArrowColour = red
   
   PredColour = blue
   SuccColour = blue

   WorldPredColour = ArrowColour
   WorldSuccColour = ArrowColour

   DefaultOzStoreTicketFile = 'http://www.info.ucl.ac.be/~glynn/OzStoreTicket'
   OzStoreTicket

   %% EarthImageURL = "http://www.info.ucl.ac.be/~glynn/earth1.pnm"

   {Property.put 'print.width' 1000}
   {Property.put 'print.depth' 1000}

   %% If argument is error then raise it as an exception
   %% If success then return content
   GetS = Util.getS

   %% As GetS, but throws away any success value and kills app on exception
   GetS_ = Util.getS_
   
   Args = try
             {Application.getArgs
              record(network(single char:&n type:atom default:default)  % P2P network name
                     fingers(single type:bool char:&f default:true)     
                     world(single type: atom char:&w default:unit)        % world view (planetlab only)
                     ozstoreticket(single type:atom default:DefaultOzStoreTicketFile)
                     ticket(single type: atom char:&t default:unit)       % client ticket
		     help(single char:[&? &h] default:false)
                     verbose(single char:&v type:int default:0) % verbosity
                    )}
          catch _ then
             {System.showInfo 'Unrecognised arguments'}
             optRec(help:true)             
          end

   if Args.help then
      {System.showInfo "Usage: "#{Property.get 'application.url'}#" [option]"}
      {System.showInfo "Options:"}
      {System.showInfo "\t"#"-n <network>, --network <network>"#"\t"#"Connect to <network>"}
      {System.showInfo "\t"#"-f, --fingers"#"\t\t"#"Draw Node Fingers (default: true)"}
      {System.showInfo "\t"#"-w <earth img>, --world <earth img>"#"\t"#"World view (PlanetLab only)"}
      {System.showInfo "\t"#"-t <ticket>, --ticket <ticket>"#"\t\t"#"Force Connection to this client ticket"}
      {System.showInfo "\t"#"--ozstoreticket <ticketfile>"#"\t\t"#"ozstore ticket file (default: "#DefaultOzStoreTicketFile#")"}
      {System.showInfo "\t"#"-v <level>, --verbose <level>"#"\t\t"#"Verbosity level"}
      {System.showInfo "\t"#"-h, --help"#"\t\t\t\t"#"This help"}
      {Application.exit 0}
   end

   %% Print all messages with Lvl less than verbosity cutoff
   Trace = {Util.mkTrace const(Args.verbose) nothing}
   TraceInfo = {Util.mkTraceInfo const(Args.verbose) nothing}

   OzStoreTicket = {Pickle.load Args.ozstoreticket}
   
   %% Retrieve p2p network entry points from OzStore
   ClientEntryPoints = if Args.ticket == unit then
                          {Map
                           {GetS {Send {Connection.take OzStoreTicket} get(Args.network $)}}
                           fun {$ _#(_#_#C)} C end}
                       else
                          [Args.ticket]
                       end
   NWHandle = {GetS {P2PKitClient.makeClient ClientEntryPoints Args.verbose}}

   %%
   %% gui_details sends the node's id, fully qualified domain name and other stats to
   %% the service in the incoming message
   %%
   DetailsS =
   local
      fun {GuiDetailsMaker Env}
         PeerHandler = {Env resolve_peer}
         success(OP2PS) = {PeerHandler getP2PSHandle}
         [OS System Record] =
         {Env resolve_module_list(['OS' 'System' 'Record'])}
         [NodeId] = {Env resolve_constant_list(['NodeId'])}
         [GetColour
          AddNotification
          MkGetS_] = {Env resolve_proc_list(['GetColour' 'AddNotification' 'MkGetSTrace_'])}
         GetS_ = {MkGetS_ 'ERROR - GUI Details' 0}
      in
         {System.show 'XXXXXXXXXX Installing Node Details Processor XXXXXXXXX'}
         %% Message will contain a servicename to send response to
         desc(processor: proc {$ M}
                            Msg = M.msg
                            Src = Msg.replyto.id
                            AP = Msg.replyto.ap
                            LAP = {OP2PS getLocalAP($)}
                         in
                            {System.show 'XXXXXXXXXX Send my Details XXXXXXXXX'}
                            {AddNotification shutdown Src AP}
                            {AddNotification newcolour Src AP}
                            {GetS_ {PeerHandler peer(ap:failureDetector
                                                     message:watch(watchId:NodeId
                                                                   notifyAddr:o(id:Src ap:AP)))}}
                            {GetS_
                             {PeerHandler peer(id:Src
                                               ap:AP
                                               message:details(id:NodeId
                                                               uname:{String.toAtom {OS.uName}.nodename}
                                                               fingertable: {Record.filter
                                                                             {OP2PS getFT($)}
                                                                             fun {$ V} V \= unit end}
                                                               pred: {OP2PS getPred($)}
                                                               succ: {OP2PS getSucc($)}
                                                               colour : {GetColour}
                                                               messageStats: {OP2PS getStatistics($)}
                                                               ap: 
                                                                  ap(ip: LAP.ip
                                                                     pn: LAP.pn)
                                                              ))}}
                         end)
      end
   in
      {GetS {NWHandle installService(name:gui_details
                                     maker:GuiDetailsMaker)}}
   end

   {Wait DetailsS}
   {TraceInfo 10 'Set up Details Service'}
   
   ControlS = {GetS {NWHandle clientOfService(name: '__control')}}

   {TraceInfo 10 'Set up Control Service'}

   ResponseStream
   ResponseAP = {GetS {NWHandle makeProxy(stream: ResponseStream)}}
   {Wait ResponseAP} %%AP must not be still a variable when we send it in a message!
   
   {Trace 10 'made proxy'}

   P2PNodeId = {GetS {NWHandle getPeerId}}
   {TraceInfo 10 'My Proxy Id is '#P2PNodeId}

   thread
      proc {Loop}
	 {GetS_ {DetailsS broadcast(message:msg(replyto:ResponseAP))}}
	 {Delay RefreshInterval}
	 {Loop}
      end
   in
      {Loop}
   end
   

   NodesRaw = {NewDictionary}        %% Currently known information per node
   NodesTS = {NewDictionary}         %% Timestamp of last message
   NodesR = {NewCell nodes}          %% Nodes on canvas
   NodeHandles = {NewDictionary}

   %% Invariants:
   %%   - Nodes in @NodesR are in NodeTS

   fun {MkNullInfo Id}
      nullinfo(colour: white
               fingertable: nil
               uname: '<not responding>'
               pred: Id
               succ: Id
               messageStats:stat(nrAppMsgs:~1
                                 nrClients:~1
                                 nrCtrlMsgs_lcl:~1
                                 nrCtrlMsgs_rm:~1
                                 nrDataMsgs_lcl:~1
                                 nrDataMsgs_rm:~1
                                 nrFingerChgs:~1
                                 nrInLinks:~1
                                 nrOutLinks:~1
                                 nrPredChgs:~1
                                 nrSuccChgs:~1
                                 useProxy:false))
   end

   CanvasControl
   
   %% Process refresh messages from the network
   thread
      for NewI in ResponseStream do
         {Trace 9 NewI}
         Id = case NewI of
                 failureDetector(deadid:I) then I
              else NewI.id
              end
      in
         %% Whoopee! - Heard from this node
         NodesTS.Id := {Property.get 'time.total'}
         case NewI of
            notify(message:newcolour(C) id:_) then
            if {Dictionary.member NodesRaw Id} then NewDetails
               OldDetails = {Dictionary.exchange NodesRaw Id $ NewDetails}
            in
               NewDetails = {AdjoinAt OldDetails colour C}
            else
               NodesRaw.Id = {AdjoinAt {MkNullInfo Id} colour C}
            end
            if {Value.hasFeature @NodesR Id} then
               {Send CanvasControl drawNode(Id)}
            else
               {TraceInfo 10 'New Colour REDRAW '#Id}
               {Send CanvasControl redraw}
            end
         [] notify(message:shutdown id:_) then
            {Trace 10 shutdown#Id}
            {Dictionary.remove NodesRaw Id}
            {TraceInfo 10 'shutdown REDRAW '#Id}
            {Send CanvasControl redraw}
         [] failureDetector(deadid:DeadId) then
            {Trace 10 failureDetector#DeadId}
            {Dictionary.remove NodesRaw DeadId}
            {TraceInfo 10 'failure detector REDRAW '#Id#' dead Id: '#DeadId}
            {Send CanvasControl redraw}

            %% Got the whole details
            %% Redraw whole canvas if:
            %% - node isn't visible, or
            %% - fingers have changed
         elseif {Value.hasFeature @NodesR Id} andthen {Dictionary.member NodesRaw Id} then
            PrevI = NodesRaw.Id
         in
            NodesRaw.Id := NewI
            if Args.fingers andthen ({List.some [PrevI.pred \= NewI.pred
                                                 PrevI.succ \= NewI.succ
                                                 PrevI.fingertable \= NewI.fingertable]
                                      fun {$ I} I end}) then
               {Trace 10 'CHANGE '#Id#[PrevI.pred \= NewI.pred
                                       PrevI.succ \= NewI.succ
                                       PrevI.fingertable \= NewI.fingertable]}
               {Send CanvasControl redraw}
            else
               if PrevI.colour \= NewI.colour then
                  {Send CanvasControl drawNode(Id)}
               end
            end
         else
            NodesRaw.Id := NewI
            {TraceInfo  10 'NEW MEMBER '#Id}
            {Send CanvasControl redraw}
         end
      end
   end


   %% Kick out non-responding (hopefully dead) nodes
   thread
      proc {Loop} Now in
	 {Delay DeadInterval}
	 Now = {Property.get 'time.total'}
	 {Record.forAllInd @NodesR
	  proc {$ I _}
	     if Now - {Dictionary.condGet NodesTS I Now} > DeadInterval then
                {TraceInfo 10 'Dead Node REDRAW '#I}
		{Send CanvasControl redraw}
	     end
	  end
	 }
	 {Loop} 
      end
   in
      {Loop}
   end
   
   Pi = 3.14159265 %% According to Google

   %% UnFold :# (T -> Bool) -> (T -> A) -> (T -> T) -> T -> [A]
   fun {UnFold P F G I} 
      if {P I} 
      then nil
      else {F I} | {UnFold P F G {G I}}
      end
   end

   fun {SegmentCircle Radius N}
      RadiusF = if {IsInt Radius} then
		   {IntToFloat Radius}
		else
		   Radius
		end
      Scale = 2.0*Pi/{IntToFloat N}
   in
      {UnFold
       fun {$ I} I == 0 end
       fun {$ I}
	  Angle = {IntToFloat I} * Scale
       in
	  (RadiusF * {Sin Angle})#(RadiusF * {Cos Angle})
       end
       fun {$ I} I - 1 end
       N}
   end

   %% From XMLParser documentation, strips all whitespace
   %% converts nodes to records with fields alist and children
   class SitesParser from XMLP.parser
      meth init
         M = {New XMLP.spaceManager init}
      in
         {M stripSpace('*' '*')}
         XMLP.parser,init
         {self setSpaceManager(M)}
      end
      meth onAttribute(Tag Value)
         {self attributeAppend(Tag.name#Value)}
      end
      meth onStartElement(Tag Alist Children)
         Name = Tag.name
      in
         {self append(
                  Name(
                     alist    : {List.toRecord alist Alist}
                     children : Children))}
      end
   end

   %% Only evaluate the Node -> long,lat if it is needed (i.e. we have world view)
   NodeInfo = {Value.byNeed
	       fun {$}
		  XMLParser = {New SitesParser init}
		  %% Ignore xml header
		  [_ PLNodesXML] =
		  {XMLParser parseURL('http://www.planet-lab.org/xml/sites.xml' $)}
	       in
		  thread
		     {List.foldL
		      PLNodesXML.children
		      fun {$ Nodes SiteRec}
			 {Adjoin Nodes
			  {List.foldL
			   SiteRec.children
			   fun {$ SiteNodes NodeRec}
			      {AdjoinAt SiteNodes
			       NodeRec.alist.'NAME'
			       o(site: SiteRec.alist.'NAME'
				 longitude: SiteRec.alist.'LONGITUDE'
				 latitude: SiteRec.alist.'LATITUDE')}
			   end
			   o()}}
		      end
		      o()}
		  end
	       end}

   FileMenu = menu(command(text:"Shut Down Network"
			   action: proc {$}
				      {GetS_ {ControlS broadcast(message: 'shutdown')}}
                                   end)
		   command(text: "Quit"
			   action: proc {$} {Application.exit 0} end)
		  )
   HelpMenu = menu(command(text: "About"
			   action: proc {$} {System.showInfo 'About'} end)
		  )
   Canvas
   WinDesc = td(title: if Args.world \= unit then
                          'The World of P2PKit'
                       else
                          'P2P Control Centre'
                       end
                lr(glue: nwe
                   menubutton(glue: w
                              text: "File"
                              menu: FileMenu
                             )
                   menubutton(glue: e
                              text: "Help"
                              menu: HelpMenu
                             )
                  )
                canvas(glue:nswe
                       handle:Canvas
                       bg:white
                       lrscrollbar: true
                       tdscrollbar:true)
                lr(glue: "sew"
                   button(text:"Refresh" glue:"esw"
                          action: proc {$}
                                     {GetS_
                                      {DetailsS broadcast(message:msg(replyto:ResponseAP))}}
                                  end)
                   button(text:"Quit"
                          glue:"esw"
                          action:proc {$} {Application.exit 0} end)
                  )
               )
   Win = {QTk.build WinDesc}
 
    
   {Win bind(event:'<KeyPress>'
             args:[atom('K')]
             action:proc{$ K}
                       if {List.member K ['q' 'Q']} then
                          {Application.exit 0}
                       elseif {List.member K ['r' 'R']} then
                          {GetS_ {DetailsS broadcast(message:msg(replyto:ResponseAP))}}
                       elseif {List.member K ['s' 'S']} then
                          {GetS_ {ControlS broadcast(message: 'shutdown')}}
                       else skip end
                    end)}
 
   EarthTag={Canvas newTag($)}
 
   if Args.world \= unit then
      Img={QTk.newImage photo(url:Args.world)}
   in
      %% put the earth image as background 
      {Canvas create(image 0 0 anchor:nw image:Img tags:EarthTag)}
   end
 
 
   IDHandle
   AddressHandle
   AppnMsgsHandle
 
   InfoBoxTags = {NewCell nil}
   CircleTag = {Canvas newTag($)}
    
   NodeSizeBy2 = if Args.world \= unit then 3.0 else 4.0 end
 
   proc {AtomToFloat A F}
      try
         {String.toFloat {Map {VirtualString.toString A}
                          fun {$ C} if C == &- then &~ else C end end}
          F}
      catch _ then
         F = 0.0
      end
   end
    
 
   proc {DrawCanvas}
      %% Redraw Canvas from Nodes
      %% Calculate Nodes to be drawn
      Now = {Property.get 'time.total'}
      NodesSnap = {Record.filter {Dictionary.toRecord nodes NodesRaw} fun {$ Info} Now - NodesTS.(Info.id) < DeadInterval end}
      NodesR := {List.foldL {Record.toList NodesSnap}
                 fun {$ NRec Entry}
                    {Trace 10 entry(Entry)}
                    {AdjoinList NRec
                     {Map Entry.id|Entry.pred|Entry.succ|{Record.toList Entry.fingertable} fun {$ I} I#unit end}}
                 end
                 nodes}
      {Trace 10 nodesr(@NodesR)}
      %% Calculate size of drawing area
      OriginX#OriginY#CHBy2#CWBy2 =
      if Args.world \= unit then
         [EarthStartX EarthStartY EarthEndX EarthEndY] =
         {Map {EarthTag bbox($)} Int.toFloat}
      in
         EarthStartX#EarthStartY#(EarthEndY - EarthStartY)/2.0#(EarthEndX - EarthStartX)/2.0
      else
         Geom = {Canvas winfo(geometry:$)}
      in
         0.0#0.0#{Int.toFloat Geom.height}/2.0#{Int.toFloat Geom.width}/2.0
      end
      NodeRadius = {Min (CHBy2-24.0) (CWBy2-40.0)}
      FingerRatio = (NodeRadius - 10.0) / NodeRadius
      TextRatio = (NodeRadius + if Args.world \= unit then
                                   5.0
                                else 9.0 end) / NodeRadius
      NodesFingersPos = {SegmentCircle NodeRadius {Record.width @NodesR}}
      proc {MercatorTransform Long Lat X Y}
         X = OriginX + ((Long/180.0)*CWBy2)
         Y = OriginY - ((Lat/90.0)*CHBy2) 
      end
      NodesPos = if Args.world \= unit then
                    {Record.mapInd NodesSnap
                     fun {$ Id _} X Y in
                        %%                        {System.show (NodesSnap.Id.uname)#NodeInfo.(NodesSnap.Id.uname).longitude}
                        {MercatorTransform
                         {AtomToFloat NodeInfo.(NodesSnap.Id.uname).longitude}
                         {AtomToFloat NodeInfo.(NodesSnap.Id.uname).latitude}
                         X Y}
                        X#Y
                     end
                    }
                 else
                    {List.toRecord nodes {List.zip
                                          {Record.arity @NodesR}
                                          NodesFingersPos
                                          fun {$ Id Pos} Id#Pos end}}
                 end
 
      {Trace 10 canv_configure#NodesPos}
   in
      {CircleTag delete}
      {ForAll @InfoBoxTags proc {$ T} {T delete}  end}
      %% Draw Nodes
      {Record.forAllInd
       NodesPos
       proc {$ Id XOffs#YOffs}
          Info = {Value.condSelect NodesSnap Id {MkNullInfo Id}}
          NTag = {Canvas newTag($)}
          FingerHandles =
          if Args.fingers then
             {Record.foldL {AdjoinList Info.fingertable [s#Info.succ p#Info.pred]}
              fun {$ FHs T}
                 if Args.world \= unit andthen
                    {Not {Value.hasFeature NodesPos T}} then
                    FHs
                 else
                    TXOffs#TYOffs = NodesPos.T
                    FX#FY#TX#TY =
                    if Args.world \= unit then
                       CWBy2 + XOffs + ((NodeSizeBy2 + 2.0)*
                                        if TXOffs >= XOffs
                                        then 1.0 else ~1.0 end)#
                       CHBy2 + YOffs#
                       CWBy2 + TXOffs + ((NodeSizeBy2 + 2.0)*
                                         if TXOffs < XOffs
                                         then 1.0 else ~1.0 end)#
                       CHBy2 + TYOffs
                    else
                       CWBy2 + (FingerRatio*XOffs)#
                       CHBy2 + (FingerRatio*YOffs)#
                       CWBy2 + (FingerRatio*TXOffs)#
                       CHBy2 + (FingerRatio*TYOffs)
                    end
                 in
                    T#
                    {Canvas create(line
                                   FX FY
                                   TX TY
                                   arrow:last
                                   fill: if T == Info.pred then
                                            if Args.world \= unit
                                            then WorldPredColour else PredColour end
                                         elseif T == Info.succ then
                                            if Args.world \= unit
                                            then WorldSuccColour else SuccColour end
                                         else ArrowColour
                                         end
                                   width: ArrowWidth
                                                 % smooth:true splinesteps:30
                                   tags: NTag handle:$)}|FHs
                 end
              end
              nil}
          else nil end
           
          proc{Enter}
             {IDHandle set(Id)}
             {AddressHandle set(Info.uname)}
             {AppnMsgsHandle set(Info.messageStats.nrAppMsgs)}
 
             {ForAll NodeHandles.Id.fingers
              proc {$ _#H}
                 {H set(fill: HighlightArrowColour width:HighlightArrowWidth)}
                 {H 'raise'}
              end}
          end
 
          proc{Leave}
             {ForAll NodeHandles.Id.fingers
              proc {$ T#H} {H set(fill: if T == Info.pred then
                                           if Args.world \= unit
                                           then WorldPredColour else PredColour end
                                        elseif T == Info.succ then
                                           if Args.world \= unit
                                           then WorldSuccColour else SuccColour end
                                        else                       ArrowColour
                                        end
                                  width:ArrowWidth)}
              end}
          end
 
          OX = XOffs+CWBy2
          OY = YOffs+CHBy2
 
          OvalHandle = {Canvas create(oval
                                      OX-NodeSizeBy2 OY-NodeSizeBy2
                                      OX+NodeSizeBy2 OY+NodeSizeBy2
                                      fill:Info.colour handle:$ tags:NTag)}
          TextX = CWBy2 + (XOffs*TextRatio)
          TextY = CHBy2 + (YOffs*TextRatio)
       in
          if P2PNodeId == Id then
             {Canvas create(oval OX-8.0 OY-8.0 OX+8.0 OY+8.0 tags:NTag)}
          end
 	  
          %% 	  if Args.world \= unit then
          %% 	     proc {Loop}
          %% 		{Delay 750}
          %% 		{OvalHandle set(fill:nil)}
          %% 		{Delay 750}
          %% 		{OvalHandle set(fill:Info.colour)}
          %% 		{Loop}
          %% 	     end
          %% 	  in
          %%              %% KEVING: How to garbage .....
          %% 	     thread
          %% 		{Loop}
          %% 	     end
          %% 	  end
          %% 
          %% 	  
          {Canvas create(text TextX TextY
                         text:Id
                         anchor: if     {Abs XOffs} < 1.0 andthen YOffs > 0.0 then n
                                 elseif {Abs XOffs} < 1.0 then s
                                 elseif {Abs YOffs} < 1.0 andthen XOffs > 0.0 then w
                                 elseif {Abs YOffs} < 1.0 then e
                                 elseif XOffs > 0.0 andthen YOffs > 0.0 then nw
                                 elseif XOffs > 0.0 then sw
                                 elseif YOffs > 0.0 then ne
                                 else se
                                 end
                         tags:NTag)}
 
          {NTag bind(event:'<Enter>'
                     action:Enter)}
          {NTag bind(event:'<Leave>'
                     action:Leave)}
          {NTag bind(event:'<3>'
                     args:[int(x) int(y)]
                     action:proc{$ X Y}
                               M={QTk.buildMenu menu(command(text:"Shut Down"
                                                             action:proc {$}
                                                                       {GetS_ {ControlS peer(id:Id
                                                                                             message: 'shutdown')}}
                                                                    end)
                                                     command(text:"Kill"
                                                             action: proc {$}
                                                                        {GetS_ {ControlS peer(id: Id
                                                                                              message: 'kill')}}
                                                                     end)
                                                     command(text:"Refresh"
                                                             action: proc {$}
                                                                        {GetS_ {DetailsS peer(id: Id
                                                                                              message: msg(replyto: ResponseAP))}}
                                                                     end)
                                                     parent:Win)}
                               WX WY
                               {Win winfo(x:WX y:WY)}
                               CX CY
                               {Canvas winfo(x:CX y:CY)}
                            in
                               {M post(X+WX+CX Y+CY+WY)}
                               %% Apparently Windows freezes with setGrab set, what to do?
                               {M setGrab}
                            end)}
          NodeHandles.Id := tags(oval: OvalHandle fingers: FingerHandles)
          {CircleTag addtag(withtag NTag)}
       end}
      {QTk.flush}
   end
    
   thread
      %% Loop through to the end of the stream
      proc {DrawReqLoop Stream DrawAll DrawNodes}
         if {IsDet Stream} then
            H|T = Stream
            {Trace 10 H}
         in
            case H of
               redraw then
               {DrawReqLoop T true nodes}
            []  canv_redraw then
               {DrawReqLoop T true nodes}
            [] drawNode(Id) then
               {DrawReqLoop T DrawAll {AdjoinAt DrawNodes Id unit}}
            else
               skip
            end
         else
            if DrawAll then
               {Trace 10 'Redrawing Canvas'}
               {DrawCanvas}
               %%{Delay 15 * 1000}
            else
               skip
               {Record.forAllInd DrawNodes
                proc {$ I _}
                   %% Only colour for now
                   {NodeHandles.I.oval
                    set(fill: {Dictionary.condGet NodesRaw I {MkNullInfo I}}.colour)}
                end
               }
            end
            {Wait Stream}
            {DrawReqLoop Stream false nodes}
         end
      end
   in
      {DrawReqLoop {NewPort $ CanvasControl} true nodes}
   end
 
   %% Whenever the canvas changes size redraw the whole thing
   {Canvas bind(event:'<Configure>'
                action: proc {$} {Send CanvasControl canv_redraw} end
               )}
 
   %% Kill any lingering menus
 %   {Canvas bind(event:'<1>'
 %		action: proc {$} {@MenuH delete} end
 %	       )}
    
   {Canvas create(window 0 0
                  window:lr(background: white
                            relief:raised
                            borderwidth: 1
                            label(init: 'Node ID: ' bg: white glue: w)
                            label(init: ' ' handle:IDHandle bg: white glue: w)
                            newline
                            label(init: 'Address: ' bg: white glue:w)
                            label(init: ' ' handle:AddressHandle bg: white glue:w)
                            newline
                            label(init: 'Appn Msgs: ' bg: white glue:w)
                            label(init: 0 handle:AppnMsgsHandle bg: white glue:w)
                           )
                  anchor: nw)}
    
   {Win show}
 

end