fmod NEW-GRAPH2G2D is
  inc GRAPH .
  inc NAT-QID .
  inc TEMPLATES .
  inc QVAL .  inc SVAL .  inc TVAL .   **** note values
  inc PL-THING2AEXP .
  
  var nid srcid tgtid : Nat .
  vars b remove? : Bool .
  var bindings : TBinds .
  vars notes gnotes : Notes .
  var ndl : NodeList .
  var edl : EdgeList .
  vars gname pname pgname kbname gtype q ptype : Qid .
  var attrids qidl oatts ratts  : QidList .
  var ?graph removedG : Graph .
  vars id str src tgt type label clabel nodesExp edgesExp  : String .
  vars nidstr valstr tagsExp valsExp selections colorFun toolBarFun : String .
  vars title subtitle : String .
  var val : Val .

var modname : Qid .
var rrStr : String .
var ranksT : Term .
vars res0?? : [ResultPair?] .

*****************************************************************************
**** helper
  op qidl2squotes : QidList -> String .
  eq qidl2squotes(nil) = "" .
  eq qidl2squotes(q qidl) = squote(string(q)) + " " + qidl2squotes(qidl) .

*****************************************************************************
**** creating KBGraph in viewer 4 string arrays
  vars occ-labs occ-ids occ-aexps occ-locs rule-labs rule-ids : String .
  vars occ-lab-arr occ-id-arr occ-aexp-arr occ-loc-arr 
         rule-lab-arr rule-id-arr : String .

  op defKBGraphTemplate : -> String [ctor] .
  eq defKBGraphTemplate = 
       "(apply defKBGraph %kbname %occ-labs  %occ-ids %occ-aexps %occ-locs %rule-labs %rule-ids)" .

***(
  op stringArrayTemplate : -> String [ctor] .
  eq stringArrayTemplate = "(array java.lang.String %strings )" .

  op objectArrayTemplate : -> String [ctor] .
  eq objectArrayTemplate = "(array java.lang.Object %strings )" .
)
  op mkdefKBGraphExp : Qid NodeList -> String .
  op mkOccArrExp : Qid NodeList String  String  String String  String  String -> String .
  eq mkdefKBGraphExp(kbname, ndl) = mkOccArrExp(kbname,ndl,"","","","","","") .

  ceq mkOccArrExp(kbname, nil,occ-labs,occ-ids,occ-aexps,occ-locs, 
                              rule-labs,rule-ids) =
       fillTemplate(defKBGraphTemplate,bindings)   
    if occ-lab-arr := 
          fillTemplate(stringArrayTemplate, ("%strings" :~ occ-labs))
    /\ occ-id-arr :=
           fillTemplate(stringArrayTemplate,("%strings" :~ occ-ids))
    /\ occ-aexp-arr :=
           fillTemplate(objectArrayTemplate,("%strings" :~ occ-aexps))
    /\ occ-loc-arr :=
           fillTemplate(stringArrayTemplate,("%strings" :~ occ-locs))
    /\ rule-lab-arr :=
        fillTemplate(stringArrayTemplate,("%strings" :~ rule-labs))
    /\ rule-id-arr :=
        fillTemplate(stringArrayTemplate,("%strings" :~ rule-ids)) 
    /\ bindings := 
      (("%kbname" :~ squote(string(kbname))),
       ("%occ-labs" :~ occ-lab-arr),
       ("%occ-ids" :~ occ-id-arr),
       ("%occ-aexps" :~ occ-aexp-arr),
       ("%occ-locs" :~ occ-loc-arr),
       ("%rule-labs" :~ rule-lab-arr),
       ("%rule-ids" :~ rule-id-arr))  .

  eq mkOccArrExp(kbname,nd(nid,(("type" := sv("occ")),notes)) ndl,
                  occ-labs,occ-ids,occ-aexps,occ-locs,rule-labs,rule-ids) =
      mkOccArrExp(kbname,ndl,
      occ-labs + " " + squote(svalString(lookupd(notes,"chattylabel",sv("")))),
      occ-ids + " " + squote(string(nid,10)),
      occ-aexps + " " + thingTl2aexp(occT2thT(tvalTerm(lookupd(notes,"occ", 
                                               tm('BOOL,'true.BOOL)))) ), 
      occ-locs + " " + squote(svalString(lookupd(notes,"loc",sv("")))),
                  rule-labs,rule-ids) .

  eq mkOccArrExp(kbname,nd(nid,(("type" := sv("rule")),notes)) ndl,
                 occ-labs,occ-ids,occ-aexps,occ-locs,rule-labs,rule-ids) =
      mkOccArrExp(kbname,ndl, occ-labs, occ-ids, occ-aexps,occ-locs,
         rule-labs + " " + 
                     squote(svalString(lookupd(notes,"chattylabel",sv("")))),
         rule-ids + " " + squote(string(nid,10))) .

**** drop nodes of unknow type -- shouldn't happen
  eq mkOccArrExp(kbname,nd(nid,notes) ndl,
                 occ-labs,occ-ids,occ-aexps,occ-locs,rule-labs,rule-ids) =
    mkOccArrExp(kbname,ndl, 
                occ-labs,occ-ids,occ-aexps,occ-locs,rule-labs,rule-ids) [owise] .


*****************************************************************************
**** making the attrs controlled by maude only
  op defineNewGraphTemplate : -> String .
  eq defineNewGraphTemplate = 
"(let ((makeGraph (lambda (graph mouseClickedClosure)\n\
        (seq\n\
         %nodes\n\
         %edges\n\
      )))\n\
        (graph (object (\"g2d.graph.IOPGraph\")))\n\
        (mouseClickedClosure \n\
          (if %ispnet \n\
             (apply mkPnetMouseClickedClosure graph)\n\
          (if %isxnet \n\
             (apply mkXnetMouseClickedClosure graph)\n\
             (object null)\n\
          )) ))\n\
   (seq\n\
     (apply setAttrsAV graph %tags %vals (int %len) (int 0))\n\
     (apply makeGraph graph mouseClickedClosure)\n\
     (setAttr graph \"colorFun\" %colorFun)\n\
     (setAttr graph \"ruleRanks\" %ruleRanks)\n\
     (setUID graph %gid)\n\
     graph\n\
   )\n\
 )"  .

**** 13nov11 setUID is a form
****      (invoke graph \"setUID\" %gid)\n\
***  17feb05 adding ruleRanks to dishnet graphs

  op mkDefineNewGraphExp : Qid Graph Notes -> String .
  ceq mkDefineNewGraphExp(gname,?graph,gnotes) = 
        fillTemplate(defineNewGraphTemplate,bindings) 
  if ql(oatts) := lookupd(gnotes,"oatts",ql(nil))
  /\ ql(ratts) := lookupd(gnotes,"ratts",ql(nil))
  /\ sv(colorFun) := lookupd(gnotes,"colorFun",sv(""))
  /\ nodesExp := ng2nodesExp(graphNodes(?graph),oatts,ratts,colorFun,"")
  /\  edgesExp := ng2edgesExp(graphEdges(?graph),"")
  /\  ql(attrids) := lookupd(gnotes,"gatts",ql(nil))
  /\  tagsExp := qids2StringArrayExp(attrids,"")
  /\  valsExp := notes2StringArrayExp(gnotes,attrids,"")
  /\ ql(ptype pname)  := lookupd(gnotes,"source",ql('unknown 'unknown))
  /\ ql(gtype)  := lookupd(gnotes,"gtype",ql('unknown))
***** 17feb05 propagating ruleRanks
  /\ tm(modname,ranksT)  
          := lookupd(gnotes,"ruleRanks",tm('QQQ,'nil.QidListList))
  /\ res0?? := metaReduce([modname],'qidll2arrstr[ranksT])
  /\ rrStr := (if res0?? :: ResultPair 
               then downTerm(getTerm(res0??),"(array java.lang.Object)") 
               else "(array java.lang.Object)" fi)  
  /\  bindings := 
     (
      ("%gid" :~ squote(string(gname))),
**** xnet could be cnet then no IOP mouse clicks
      ("%ispnet" :~ (if ptype == 'pnet 
                    then "(boolean true)"  **** respond to mouse click
                    else "(boolean false)" fi)),
**** 13sep29 clt testing cnet is xnet
****      ("%isxnet" :~ (if ptype == 'xnet and gtype =/= 'cnet
****                    then "(boolean true)"  **** respond to mouse click
****                    else "(boolean false)" fi)),
      ("%isxnet" :~ (if ptype == 'xnet
                    then "(boolean true)"  **** respond to mouse click
                    else "(boolean false)" fi)),
      ("%tags" :~ tagsExp),
      ("%vals" :~ valsExp),
      ("%len" :~ string(size(attrids),10)),
      ("%colorFun" :~ colorFun),
***** 17feb05 propagating ruleRanks
      ("%ruleRanks" :~ rrStr),
      ("%nodes" :~ nodesExp),
      ("%edges" :~ edgesExp)) .


  op qids2StringArrayExp : QidList String -> String .
  eq qids2StringArrayExp(nil,str) = "(array java.lang.String " + str + ")" .
  eq qids2StringArrayExp(q qidl,str) = 
          qids2StringArrayExp(qidl,str + " " + squote(string(q))) .

  op notes2StringArrayExp : Notes QidList String -> String .
  eq notes2StringArrayExp(notes,nil,str) = "(array java.lang.String " + str + ")" .

  ceq notes2StringArrayExp(notes, q qidl,str) = 
       notes2StringArrayExp(notes,qidl, str + " " + squote(valstr))
   if val := lookupd(notes,string(q),dummy)
   /\ valstr :=
             (if val :: QVal
              then qidl2str(qvalQidList(val))
              else (if val :: SVal
                    then svalString(val)
                    else "" fi) fi) .


**** making the attrs controlled by maude only
  op newNodeTemplate : -> String .
  eq newNodeTemplate = 
"(apply %newNode graph mouseClickedClosure %nid %lab %clab %tags %vals %colorFun)" .

  op ng2nodesExp : NodeList QidList QidList String String -> String .
  op ng2ndExp : Nat Notes QidList QidList String -> String .

  eq ng2nodesExp(nil,oatts,ratts,colorFun,nodesExp) = nodesExp .
  eq ng2nodesExp(nd(nid,notes) ndl,oatts,ratts,colorFun,nodesExp) =
       ng2nodesExp(ndl,oatts,ratts, colorFun,
         nodesExp + ng2ndExp(nid,notes,oatts,ratts,colorFun) + "\n") .
  
  ceq ng2ndExp(nid,notes,oatts,ratts,colorFun) =    
       (if type == "occ" or type == "rule"
        then fillTemplate(newNodeTemplate,bindings)
        else "" fi) 
   if sv(type) := lookupd(notes,"type",sv("")) 
   /\ label :=
        svalString(lookupd(notes,"label",sv("")))        *** label attr
   /\ clabel :=
        svalString(lookupd(notes,"chattylabel",sv("")))  *** clabel attr
   /\ nidstr :=  string(nid,10)                          *** nid attr
   /\ tagsExp := 
       qids2StringArrayExp(if type == "occ" then oatts else ratts fi,"")
   /\ valsExp :=
       notes2StringArrayExp(notes,if type == "occ" then oatts else ratts fi,"")
   /\ bindings :=
           (("%newNode" :~
                 (if type == "occ" then "newOccNode" else "newRuleNode" fi)),
             ("%nid" :~ squote(nidstr)),
             ("%lab" :~ squote(label)),
             ("%clab" :~ 
                  squote(if clabel == "" then label else clabel fi)),
             ("%tags" :~ tagsExp),
             ("%vals" :~ valsExp),
             ("%colorFun" :~ colorFun) )  .

  op newEdgeTemplate : -> String .
  eq newEdgeTemplate = "(apply newEdge graph %edgeSrc %edgeTgt %bidir?)" .

  op ng2edgesExp : EdgeList  String -> String .
  op ng2edExp : Nat Nat Notes -> String .

  eq ng2edgesExp(nil,edgesExp) = edgesExp .
  eq ng2edgesExp(ed(srcid,tgtid,notes) edl,edgesExp) = 
       ng2edgesExp(edl, edgesExp + ng2edExp(srcid,tgtid,notes) + "\n") .  

  ceq ng2edExp(srcid,tgtid,notes) = 
        fillTemplate(newEdgeTemplate,bindings)
   if type := svalString(lookupd(notes,"type",sv("unidir")))
   /\ src :=  string(srcid,10) 
   /\ tgt :=  string(tgtid,10) 
   /\ bindings := 
        (("%bidir?" :~ squote(if type == "bidir" then "true" else "false" fi)),
         ("%edgeSrc" :~ squote(src)),
         ("%edgeTgt" :~ squote(tgt)))  .

  op showNewGraphTemplate : -> String .
  eq showNewGraphTemplate =
 "(apply showNewGraph %gname %parent %selections %title %subtitle  %toolBarFun )" .

  op mkShowNewGraphExp : Qid Notes -> String .
  ceq mkShowNewGraphExp(gname,notes) =
        fillTemplate(showNewGraphTemplate,bindings)
  if sv(toolBarFun) :=  lookupd(notes,"toolBarFun",sv(""))
   /\ sv(title) := lookupd(notes,"title",sv(string(gname)))
   /\ sv(subtitle) := lookupd(notes,"subtitle",sv(""))
   /\ sv(selections) := lookupd(notes,"selections",sv("false"))
   /\ ql(pgname) := lookupd(notes,"parent",ql('unknown))
   /\ bindings := 
        (("%gname" :~ squote(string(gname))),
         ("%title" :~ squote(title)),
         ("%subtitle" :~ squote(subtitle)),
         ("%toolBarFun" :~ toolBarFun),
         ("%selections" :~ (if selections == "true" 
                            then "(boolean true)"
                            else "(boolean false)" fi)),
         ("%parent" :~ (if pgname == 'unknown
                        then "(object null)" 
                            else squote(string(pgname)) fi)) ) .

*****************************************************************************
**** updating a graph
*****************************************************************************

****17feb18 fixing missing requestargs update

  op graphNewExtendTemplate : -> String .
  eq graphNewExtendTemplate = 
"(let ((graph (fetch %gid))\
       (mouseClickedClosure (apply mkXnetMouseClickedClosure graph))\n\
       )\n\
      (seq\n\
      (apply setAttrsAV graph %tags %vals (int %len) (int 0))\n\
        %nodes\n\
        %edges\n\
      )\n\
 )"  .

****        (apply resetXselect graph)\n\

  op graphNewRemoveTemplate : -> String .
  eq graphNewRemoveTemplate = 
"(let ((graph (fetch %gid)))\n\
        (seq\n\
        (apply setAttrsAV graph %tags %vals (int %len) (int 0))\n\
         %edges\n\
         %nodes\n\
      )\n\
 )"  .

  op mkupdXGraphExp : Qid Graph Graph Notes -> String .
  ceq mkupdXGraphExp(gname,?graph,removedG,gnotes) =
      (if remove?
       then fillTemplate(graphNewRemoveTemplate,bindings) 
       else fillTemplate(graphNewExtendTemplate,bindings) 
      fi)
  if remove? := removedG =/= mtGraph
  /\ ndl := graphNodes(if remove? then removedG else ?graph fi)
  /\ edl := graphEdges(if remove? then removedG else ?graph fi)
  /\ ql(oatts) := lookupd(gnotes,"oatts",ql(nil))
  /\ ql(ratts) := lookupd(gnotes,"ratts",ql(nil))
  /\ sv(colorFun) := lookupd(gnotes,"colorFun",sv(""))
  /\ nodesExp := (if remove?
                  then removeXGNodesExp(ndl,"")
                  else addXGNodesExp(ndl,oatts,ratts,colorFun,"")
                  fi)
  /\ edgesExp :=  (if remove?
                  then removeXGEdgesExp(edl,"")
                  else addXGEdgesExp(edl,"")
                 fi)
/\  tagsExp := qids2StringArrayExp('requestargs,"")
/\  valsExp := notes2StringArrayExp(gnotes,'requestargs,"")
  /\ bindings := 
     (("%gid" :~ squote(graphId(?graph))),
  ("%tags" :~ tagsExp),
  ("%vals" :~ valsExp),
  ("%len" :~ "1"),
      ("%nodes" :~ nodesExp),
      ("%edges" :~ edgesExp)) .

  op addXGNodesExp :  NodeList QidList QidList String String -> String .
  op addXGEdgesExp  : EdgeList String -> String .

  eq addXGNodesExp(nil,oatts,ratts,colorFun,str) = str .
  eq addXGNodesExp(nd(nid,notes) ndl,oatts,ratts,colorFun,str) = 
      addXGNodesExp(ndl,oatts,ratts,colorFun, str +
      (if lookupd(notes,"new",sv("false")) == sv("true") 
***       then ng2ndExp(nid,notes,oatts,ratts,colorFun) + "\n"  
       then ng2xndExp(nid,notes,oatts,ratts,colorFun) + "\n"  
       else **** (if lookupd(notes,"type",sv("none")) == sv("occ")  then 
            "(apply updateXNode graph " +  squote(string(nid,10)) + " " 
                   + " " + squote(svalString(lookupd(notes,"xstatus",sv("none"))))
                           + " " + colorFun + ")" + "\n"  
****             else "" fi) 
         fi)) .
 
  eq addXGEdgesExp(nil,str) = str . 
  eq addXGEdgesExp(ed(srcid,tgtid,notes) edl,str) = 
      addXGEdgesExp(edl, str +
           (if lookupd(notes,"new",sv("false")) == sv("true") 
***            then ng2edExp(srcid,tgtid,notes) + "\n"
            then ng2xedExp(srcid,tgtid,notes) + "\n"
            else ""
            fi)) .


**** making the attrs controlled by maude only
  op newXNodeTemplate : -> String .
  eq newXNodeTemplate = 
"(apply newXNode graph %type mouseClickedClosure %nid %lab %clab %tags %vals %colorFun)" .

  op ng2xndExp : Nat Notes QidList QidList String -> String .
  ceq ng2xndExp(nid,notes,oatts,ratts,colorFun) =    
     fillTemplate(newXNodeTemplate,bindings)
   if sv(type) := lookupd(notes,"type",sv("")) 
   /\ label :=
        svalString(lookupd(notes,"label",sv("")))        *** label attr
   /\ clabel :=
        svalString(lookupd(notes,"chattylabel",sv("")))  *** clabel attr
   /\ nidstr :=  string(nid,10)                          *** nid attr
   /\ tagsExp := 
       qids2StringArrayExp(if type == "occ" then oatts else ratts fi,"")
   /\ valsExp :=
       notes2StringArrayExp(notes,if type == "occ" then oatts else ratts fi,"")
   /\ bindings :=
           (("%newNode" :~
                 (if type == "occ" then "newOccNode" else "newRuleNode" fi)),
             ("%type" :~ squote(type)),
             ("%nid" :~ squote(nidstr)),
             ("%lab" :~ squote(label)),
             ("%clab" :~ 
                  squote(if clabel == "" then label else clabel fi)),
             ("%tags" :~ tagsExp),
             ("%vals" :~ valsExp),
             ("%colorFun" :~ colorFun) )  .

  op newXEdgeTemplate : -> String .
  eq newXEdgeTemplate = "(apply newXEdge graph %edgeSrc %edgeTgt %bidir?)" .

  op ng2xedExp : Nat Nat Notes -> String .
  ceq ng2xedExp(srcid,tgtid,notes) = 
        fillTemplate(newXEdgeTemplate,bindings)
   if type := svalString(lookupd(notes,"type",sv("unidir")))
   /\ src :=  string(srcid,10) 
   /\ tgt :=  string(tgtid,10) 
   /\ bindings := 
        (("%bidir?" :~ squote(if type == "bidir" then "true" else "false" fi)),
         ("%edgeSrc" :~ squote(src)),
         ("%edgeTgt" :~ squote(tgt)))  .

****!!!! delete incontext

**** remove existing (old) node
  op ngDelNodeTemplate : -> String .
  eq ngDelNodeTemplate =  "(apply delXNode graph  %nodeId)" .

****   "(invoke graph \"rmNode\" (invoke graph \"getNode\" %nodeId))" .

  op ng2ndDelExp : Nat -> String .
  eq ng2ndDelExp(nid) =     
      fillTemplate(ngDelNodeTemplate,("%nodeId" :~ squote(string(nid,10)))) .


**** remove existing (old) edge
  op ngDelEdgeTemplate : -> String .
  eq ngDelEdgeTemplate = "(apply delXEdge graph  %srcId %tgtId)" .

**** "(invoke graph \"rmEdge\" \n\
****    (invoke graph \"getEdge\" \n\
****     (invoke graph \"getNode\" %srcId) (invoke graph \"getNode\" %tgtId)))" .


  op ng2edDelExp : Nat Nat -> String .
  eq ng2edDelExp(srcid,tgtid) =     
      fillTemplate(ngDelEdgeTemplate,
           (("%srcId" :~ squote(string(srcid,10))),
            ("%tgtId" :~ squote(string(tgtid,10))))) .


  op removeXGNodesExp : NodeList String -> String .
  op removeXGEdgesExp  : EdgeList String -> String .

  eq removeXGNodesExp(nil,str) = str .
  eq removeXGNodesExp(nd(nid,notes) ndl,str) =
     removeXGNodesExp(ndl, str + ng2ndDelExp(nid) ) .

  eq removeXGEdgesExp(nil,str) = str .
  eq removeXGEdgesExp(ed(srcid,tgtid,notes) edl,str) =
     removeXGEdgesExp(edl, str + ng2edDelExp(srcid,tgtid) ) .

*****************************************************************************
**** showing an updated graph
*****************************************************************************

 op xshowUGraphTemplate : -> String .
  eq xshowUGraphTemplate = "(apply showUXGraph %gid)"  .

**** called with false
  op mkshowUXGraphExp :  Qid  -> String .

  eq mkshowUXGraphExp(gname) = 
       fillTemplate(xshowUGraphTemplate,("%gid" :~ squote(string(gname)))) . 


*****************************************************************************
**** saving jlambda expression for graph
*****************************************************************************
  op savedNewGraphTemplate : -> String .
  eq savedNewGraphTemplate = 
"(seq \n\
   %loadstr\n\
   %defineNewGraph\n\
   %showNewGraph\n\
 )"  .

**** clt removed 12oct06
**** (apply defKBManager)\n\

  op mkSavedNewGraphExp : Qid Graph Notes  -> String .
  ceq mkSavedNewGraphExp(gname,?graph,gnotes) = 
        fillTemplate(savedNewGraphTemplate,bindings) 
  if bindings := 
     (
      ("%defineNewGraph" :~ mkDefineNewGraphExp(gname,?graph,gnotes)),
      ("%showNewGraph" :~ mkShowNewGraphExp(gname,
                                      insert("parent",ql('unknown),gnotes))),
      ("%loadstr" :~ loadprefix1) ) .

  op loadprefix1 : -> String .
  eq loadprefix1 = "(load \"../../PLALib/g2dlib.lsp\")\n" .


endfm




