# # spygraph.icn # link graphics record RGB(r,g,b) record SpyderGui(GuiObjDB,Segments,LineDB,XOrg,YOrg,Radius,NextP,NextAngle, PointRadius,AngleInc,RadAngleInc,Density,Scale, PointRadiusScale,MainAngleInc,ArrowLen) # gui information for a given spyder table in a particular region record KeyGuiInfo(p,LastLine) # gui information for any key which is used in StructDB record POINT(x,y) record KeyPairs(src,des,index,lflag) # lflag tells if these two points are linked or not global Rescale global RescaleTable global CurTable global ScratchPadOldWin # used to store the &window when switching between # the scratch pad and the visible window global ListPadOldWin global ScratchPad global ListPad global TableContext global RecordContext global ListContext global ArrowContext global STableContext global SRecordContext global SListContext global SArrowContext global STypeContexts global STickContext global LPTableContext global LPRecordContext global LPListContext global LPArrowContext global LPTypeContexts global LPTickContext global BaseContext global GTableContext global GRecordContext global GListContext global GArrowContext global GPathContext global GXOrg global GYOrg global DrawRect global ArrowLength global LineColors global MergeContexts # initialize the canvases for all drawing not just one spyder table procedure InitGui(w,h) local thewindow thewindow := WOpen("label=Structure Spy System","size="||w||","||h,"fg=white","bg=light gray") | stop("can't open window") ScratchPad := WOpen("size="||w||","||h,"bg=light gray","canvas=hidden") | stop("can't open window") ListPad := WOpen("size="||w||","||h,"bg=light gray","canvas=hidden") | stop("can't open window") &window := thewindow ScratchPadOldWin := &window # ScratchPadOldWin contains the handle for the visible window SetupContexts(&window) SetupScreenContexts() SetupLineColors() end procedure SetupLineColors() local num local ri,inc,bi num := 10 ri := 65535 bi := 0 inc := 65535.0/10 LineColors := list(num) every k:= 1 to num do { LineColors[k] := RGB(ri,0,bi) LineColors[k] := Clone(&window,"linewidth=3","fg="||LineColors[k].r||","||LineColors[k].g||","||LineColors[k].b) ri -:= inc bi +:= inc } end procedure SetupContexts() BaseContext := Clone(&window) MergeContexts := list(3) every i := 1 to 3 do MergeContexts[i] := Clone(&window) WAttrib(MergeContexts[1],"fg=light blue","fillstyle=masked","pattern=vertical") WAttrib(MergeContexts[2],"fg=light blue","fillstyle=masked","pattern=diagonal") WAttrib(MergeContexts[3],"fg=light blue","fillstyle=masked","pattern=horizontal") GTableContext := Clone(&window) GRecordContext := Clone(&window) GListContext := Clone(&window) GArrowContext := Clone(&window) GPathContext := Clone(&window) STableContext := Clone(ScratchPad) SRecordContext := Clone(ScratchPad) SListContext := Clone(ScratchPad) SArrowContext := Clone(ScratchPad) LPTickContext := Clone(ListPad,"fg=black") LPTableContext := Clone(ListPad) LPRecordContext := Clone(ListPad) LPListContext := Clone(ListPad) LPArrowContext := Clone(ListPad) WAttrib(GTableContext,"fg=red") WAttrib(STableContext,"fg=red") WAttrib(LPTableContext,"fg=red") WAttrib(GRecordContext,"fg=yellow") WAttrib(SRecordContext,"fg=yellow") WAttrib(LPRecordContext,"fg=yellow") WAttrib(GListContext,"fg=blue") WAttrib(SListContext,"fg=blue") WAttrib(LPListContext,"fg=blue") WAttrib(GPathContext,"fg=green") WAttrib(GArrowContext,"fg=red") WAttrib(SArrowContext,"fg=red") WAttrib(LPArrowContext,"fg=red") STypeContexts := table() STypeContexts["list"] := Clone(ListPad,"fg=blue","linewidth=2") STypeContexts["table"] := Clone(ListPad,"fg=green","linewidth=2") STypeContexts["integer"] := Clone(ListPad,"fg=magenta","linewidth=2") STypeContexts["real"] := Clone(ListPad,"fg=black","linewidth=2") STypeContexts["string"] := Clone(ListPad,"fg=orange","linewidth=2") STypeContexts["record"] := Clone(ListPad,"fg=red","linewidth=2") STypeContexts["cset"] := Clone(ListPad,"fg=pink","linewidth=2") end # init gui information for one spyder table # when the spyder table gets created it must receive spyder gui information # here we create the spyder gui information and set up the variables referring # to a particular spyder table # procedure InitSpyGui(region) region.spygui.XOrg := region.rect.x1 + region.rect.width/2 region.spygui.YOrg := region.rect.y1 + region.rect.height/2 SetupScale(region.spygui) region.spygui.Radius := region.rect.width/2 # half the size of the minimum region.spygui.MainAngleInc := 40 region.spygui.AngleInc := region.spygui.MainAngleInc region.spygui.RadAngleInc := dtor(region.spygui.AngleInc) # every 10 degrees InitCoordInfo(region.spygui) region.spygui.PointRadius := region.spygui.Radius/region.spygui.PointRadiusScale region.spygui.Radius -:= region.spygui.PointRadius*1.5 # 1.5 is a fudge factor region.spygui.GuiObjDB := table() # xy location information of all objects region.spygui.Segments := table(0) region.spygui.LineDB := table() # holds xy location of line number text objects region.spygui.ArrowLen := 0.03 * region.rect.width end # GAttachRect # Purpose: # This routine is called when a new rectangle has been attached to a spyder # table. This routine will then draw the spydertable in its new position # procedure GAttachRect(t) InitSpyGui(SpyderDB[t].region) ReDraw(t) #IOLoop() end procedure GDetachRect(t) local rect rect := SpyderDB[t].region.rect EraseArea(ScratchPad,rect.x1,rect.y1,rect.width,rect.height) ShowFreeRect(rect) end # procedure SetupScale(spy) spy.Scale := 1 spy.PointRadiusScale := 30 end procedure InitCoordInfo(spy) spy.NextAngle := 0 # zero degrees spy.NextP := GetPoint(spy,0) # everything in radians end procedure SetupScreenContexts() TableContext := GTableContext ListContext := GListContext ArrowContext := GArrowContext RecordContext := GRecordContext end procedure SetupScratchContexts() TableContext := STableContext ListContext := SListContext ArrowContext := SArrowContext RecordContext := SRecordContext end procedure SetupListPadContexts() TableContext := LPTableContext ListContext := LPListContext RecordContext := LPRecordContext ArrowContext := LPArrowContext end procedure GetPoint(spy,deg) local p p := POINT() deg := dtor(deg) p.x := spy.XOrg+cos(deg)*spy.Radius p.y := spy.YOrg+sin(deg)*spy.Radius return p end procedure DestroySpyderGui(SpyderTable) SpyderDB[SpyderTable].region.spygui := &null SpyderDB[SpyderTable].orderlist := &null end procedure GRemoveTable(t) local reggui local rect CurTable := SpyderTable reggui := GetSpyderRegion(t) rect := reggui.rect WAttrib(BaseContext,"fillstyle=masked","pattern=grains","fg=dark gray") FillRectangle(BaseContext,rect.x1,rect.y1,rect.width,rect.height) return rect end procedure GetSpyGuiInfo(SpyderTable) return SpyderDB[SpyderTable].region.spygui end # places an object on the circum # procedure GAddTableLink(SpyderTable,srckey,deskey,Redrawing) local frpoint,topoint local spygui,reg,res #write("*************** Adding table link *****************") CurTable := SpyderTable spygui := GetSpyGuiInfo(SpyderTable) ArrowLength := spygui.ArrowLen reg := GetSpyderRegion(SpyderTable) if /Redrawing then BeginDraw(reg.rect) res := AddSegment(spygui,srckey,deskey) frpoint := PlotKey(spygui,srckey) topoint := PlotKey(spygui,deskey) if res > 1 then ArcPoints(frpoint,topoint,res) LinkPoints(frpoint,topoint) if /Redrawing then { ShowLineAdd(frpoint,topoint) } # if /Redrawing then { # write("$$$$$$$$ calling ShowAllDetailObjs in AddGuiObj$$$$") # ShowAllDetailObjs() # } if /Redrawing then { EndDraw() ShowUsedRect(reg.rect) } WFlush() if Adding = 1 then { ShowAdding(reg.rect) Adding := 0 } end procedure GRemoveTableLink(SpyderTable,srckey,deskey,NoDraw) local srcinfo local desinfo CurTable := SpyderTable srcinfo := GetKeyGuiInfo(srckey) desinfo := GetKeyGuiInfo(deskey) ShowLineRemove(srcinfo.p,desinfo.p) if /NoDraw then { ReDraw(SpyderTable) #IOLoop() } WFlush() delay(200) end procedure GMergeRects(SrcTable,DesTable) local i local srcreg,desreg local srcrect,desrect local newrect CurTable := SrcTable srcreg := GetSpyderRegion(SrcTable) desreg := GetSpyderRegion(DesTable) srcrect := srcreg.rect desrect := desreg.rect every i := 1 to 3 do { every j := 1 to 3 do { FillRectangle(MergeContexts[j],srcrect.x1,srcrect.y1,srcrect.width,srcrect.height) FillRectangle(MergeContexts[j],desrect.x1,desrect.y1,desrect.width,desrect.height) delay(200) WFlush(MergeContexts[j]) } } #IOLoop() newrect := MergeRect(srcrect,desrect) AttachRect(newrect,SrcTable) end procedure ShowLineAdd(frpoint,topoint) local curwin curwin := &window every k := 10 to 1 by -1 do { &window := LineColors[k] WFlush() DrawLine(frpoint.x,frpoint.y,topoint.x,topoint.y) delay(delaytime) } &window := curwin DrawLine(frpoint.x,frpoint.y,topoint.x,topoint.y) end procedure ShowLineRemove(frpoint,topoint) local curwin curwin := &window every k := 1 to 10 do { &window := LineColors[k] WFlush() DrawLine(frpoint.x,frpoint.y,topoint.x,topoint.y) delay(delaytime) } &window := curwin DrawLine(frpoint.x,frpoint.y,topoint.x,topoint.y) end procedure ShowLineNumLink(srckey,fp,deskey,tp) local linenum, dx, dy local lp,ds,loc,oldfg,bg,st,dt,lc, ns lp := POINT() linenum := GetLineNum(srckey,deskey) dx := tp.x - fp.x dy := tp.y - fp.y if \linenum then { ds := string(linenum) #srctype||":"||linenum||":"||destype lp.x := fp.x+dx/2#-20 lp.y := fp.y+dy/2 loc := location64(lp.x,lp.y) if member(LineDB,loc) then { oldfg := WAttrib("fg") bg := WAttrib("bg") WAttrib("fg="||bg) # set foreground to background DrawString(lp.x, lp.y,LineDB[loc]) WAttrib("fg="||oldfg) } LineDB[loc] := ds DrawString(lp.x, lp.y, ds) lp.y +:= WAttrib("fheight")+1 st := "" dt := "" if *StructDB[srckey].varnamelist > 0 then{ lc := StructDB[srckey].varnamelist every k := 1 to *lc-1 do { st ||:= StripNameScope(lc[k])||"," } st ||:= StripNameScope(StructDB[srckey].varnamelist[-1]) } else st := "-" if *StructDB[deskey].varnamelist>0 then{ lc := StructDB[deskey].varnamelist every k := 1 to *lc-1 do { dt ||:= StripNameScope(lc[k])||"," } dt ||:= StripNameScope(StructDB[deskey].varnamelist[-1]) } else dt := "-" ns := st||":"||dt DrawString(lp.x,lp.y,ns) } end procedure FindStructFromPoint(x,y) local k,px,py,f f:=0 every k := key(GuiObjDB) do { px := xlocation(k) py := ylocation(k) rad := sqrt((x-px)*(x-px)+(y-py)*(y-py)) if rad <= 5 then { f:= 1 break } } if f=1 then return k end #procedure ShowLineNum(p,linenum,label) # local k # if \linenum then # DrawString(p.x,p.y,label || linenum) #end procedure ShowImmediatePath(x,y,sep) local px,py,k local f if k := FindStructFromPoint(x,y) then { write("A total of ",*GuiObjDB[k]," Lists are located here") every p := key(GuiObjDB[k]) do { HighlightPath(p) write("Found ",p) } } end procedure PlotKey(spygui,key) local p,g,loc,tl local gi,inc,keyhandle,type local spyinfo inc := 0 if /key then return gi := GetKeyGuiInfo(key) if /gi then { #write(" keyguiinfo is &null, for key: ", image(key)) p := GetPoint(spygui,spygui.NextAngle) GetNextAngle(spygui) SetKeyGuiInfo(key,KeyGuiInfo(p)) loc := location64(p.x,p.y) if not member(spygui.GuiObjDB,loc) then spygui.GuiObjDB[loc] := table() # table of keys at some x,y location } else { p := gi.p #write(" keyguiinfo is not &null, for key: ", image(key)) #write(" its x: ", p.x, " y: ", p.y) } loc := location64(p.x,p.y) if *spygui.GuiObjDB[loc] > 1 then inc := 2 type := GetObjType(key) if type == "L" then { #write(" points at position: x: ", p.x, "y: ", p.y) ShowList(ListContext,p.x,p.y,spygui.PointRadius+inc) } else if type == "T" then ShowList(TableContext,p.x,p.y,spygui.PointRadius+inc) else ShowList(RecordContext,p.x,p.y,spygui.PointRadius+inc) spygui.GuiObjDB[loc][key] :=1 return p end procedure GuiListChange(ObjName) if IsObjLinked(ObjName) then { # write(" @@@ in GuiListChange, obj: ", ObjName, " is linked") ShowAllDetailObjs() } # else # write("@@@ in GuiListChange, obj: ", ObjName, " is not linked") end procedure ShowAllDetailObjs() local links,g # write("#### calling BeginListDraw()####") BeginListDraw() every links := GenSpyderTableKeys(CurSpyderTable) do { #if IsDirty(links) then { keyhandle := GetHandle(links) g:=GetGuiInfo(links) if \keyhandle then { if type(keyhandle) == "list" then ShowDetailList(links,keyhandle,1) else ShowDetailTable(links, keyhandle, 1) #SetClean(links) } #} } # write("#### calling EndListDraw()####") EndListDraw() end # # ShowDetailList # Note: this routine expects to be writing on the list pad # context! Don't forget! # procedure ShowDetailList(obj,objnum,ReDrawing) local guiinfo,p,NumPixelPerElem local theta,cp,np ,curelem,NewRadius local origin if *objnum = 0 then return #write("Show detail for:",image(obj)) guiinfo := GetGuiInfo(obj) origin := POINT(GXOrg,GYOrg) if /ReDrawing then BeginListDraw() p := guiinfo.p # get the x,y position of the list on the circle NumPixelPerElem := real(Radius)/real(*objnum) cp := POINT(p.x,p.y) np := POINT() if p.x-GXOrg = 0 then { if p.y-GYOrg > 0 then theta := 90 else theta := -90 } else theta := atan(p.y-GYOrg, p.x-GXOrg) NewRadius := Radius every curelem := 1 to *objnum do { NewRadius -:= NumPixelPerElem np.x := GXOrg + (NewRadius * cos(theta)) np.y := GYOrg + (NewRadius * sin(theta)) t := type(objnum[curelem]) if not member(STypeContexts,t) then t := "record" DrawLine(STypeContexts[t],cp.x,cp.y,np.x,np.y) DrawTick(origin,theta,NewRadius,3) cp.x := np.x cp.y := np.y } if /ReDrawing then EndListDraw() end # Note: this routine expects to be writing on the list pad # context! Don't forget! # this function can be made it combined with ShowDetailList later !!!! # procedure ShowDetailTable(obj,objnum,ReDrawing) local guiinfo,p,NumPixelPerElem local theta,cp,np ,curkey,NewRadius local origin if *objnum = 0 then return #write("Show detail for:",image(obj)) guiinfo := GetGuiInfo(obj) origin := POINT(GXOrg,GYOrg) if /ReDrawing then BeginListDraw() p := guiinfo.p # get the x,y position of the list on the circle NumPixelPerElem := real(Radius)/real(*objnum) cp := POINT(p.x,p.y) np := POINT() theta := atan(p.y-GYOrg, p.x-GXOrg) NewRadius := Radius every curkey := key(objnum) do { NewRadius -:= NumPixelPerElem np.x := GXOrg + (NewRadius * cos(theta)) np.y := GYOrg + (NewRadius * sin(theta)) t := type(objnum[curkey]) if not member(STypeContexts,t) then t := "record" DrawLine(STypeContexts[t],cp.x,cp.y,np.x,np.y) DrawTick(origin,theta,NewRadius,3) cp.x := np.x cp.y := np.y } if /ReDrawing then EndListDraw() end #procedure ListIndicator(ObjName) # local guiinfo, p, np # # guiinfo := GetGuiInfo(ObjName) # p := guiinfo.p # get the x, y position of the list on the circle # np := POINT(p.x-2, p.y-5) # # DrawListIndicator(GTableContext, np.x, np.y, 2) #end #procedure DrawListIndicator(w, x, y, r) # FillCircle(w, x, y, r) #end procedure DrawTick(origin, theta, radius, ticklen, nodraw) local np1,np2, alpha,newradius np1 := POINT(0,0) np2 := POINT(0,0) alpha := atan(ticklen,radius) # new angle above line newradius := sqrt(ticklen*ticklen+radius*radius) np1.x := origin.x + newradius * cos(theta+alpha) np1.y := origin.y + newradius * sin(theta+alpha) np2.x := origin.x + newradius * cos(theta-alpha) np2.y := origin.y + newradius * sin(theta-alpha) if /nodraw then DrawLine(LPTickContext,np1.x,np1.y,np2.x,np2.y) else if nodraw = 1 then return np1 else return np2 end procedure ShowList(w,x,y,r) FillCircle(w,x,y,r) end procedure CalcAngleInc(spy,num) if num > 0 then spy.AngleInc := 360/(num+1) else RescaleAngleInc(spy) CheckPointCollision(spy) end procedure CheckPointCollision(spy) theta := atan(spy.PointRadius*3,spy.Radius-spy.PointRadius) # this is the minimum angle between two points # on the circumference of a circle # we check this and reduce the point radius size if there are # too many points on the circum of the circle if theta > dtor(spy.AngleInc) then { spy.PointRadius *:= 0.50 } end procedure GetNextAngle(spy) local rad local theta spy.NextAngle +:= spy.AngleInc #write("Next Angle is ",NextAngle) if spy.NextAngle >= 360 then { Rescale := 1 RescaleTable := CurTable CheckPointCollision(spy) } end procedure RescaleAngleInc(spy) spy.MainAngleInc /:= 2 spy.AngleInc := spy.MainAngleInc end procedure LinkPoints(frpoint,topoint) local k DrawLine(frpoint.x,frpoint.y,topoint.x,topoint.y) ArrowHead(frpoint,topoint) end procedure ArcPoints(frpoint,topoint,num) local midpoint local h local theta,radius local np local dx,dy,flag dx := (topoint.x-frpoint.x) dy := (topoint.y-frpoint.y) midpoint := POINT(frpoint.x+dx/2,frpoint.y+dy/2) radius := sqrt(dx*dx+dy*dy)/2 if dx ~= 0 then theta := atan(dy,dx) else { if dy > 0 then theta := 90 else theta := -90 } flag :=0 if num%2 =0 then flag := 1 np := DrawTick(frpoint,theta,radius,num*2+1,flag) DrawCurve(frpoint.x,frpoint.y,np.x,np.y,topoint.x,topoint.y) end procedure HighlightPath(frkey) local k &window := GPathContext every k := GenLinks(frkey) do LinkKey(frkey,k) &window := BaseContext end procedure LinkKey(frkey,tokey) local frgui,togui frgui:= GetGuiInfo(frkey) togui:= GetGuiInfo(tokey) LinkPoints(frgui.p,togui.p) end procedure RemoveObj(srcgui) end procedure AddSegment(spygui,frkey,tokey) local segdb segdb := spygui.Segments return segdb[frkey||tokey] +:= 1 end procedure location64(x,y) return ior(ishift(x,32),y) end procedure xlocation(loc) return iand(ishift(loc,-32),16rFFFFFFFF) end procedure ylocation(loc) return iand(loc,16rFFFFFFFF) end procedure BeginListDraw(NoCopy) if /NoCopy then { CopyArea(ScratchPad,ListPad) } ListPadOldWin := &window &window := ListPad SetupListPadContexts() end procedure EndListDraw() &window := ScratchPadOldWin #ListPadOldWin SetupScreenContexts() CopyArea(ListPad,&window) end procedure BeginDraw(rect,NoCopy) &window := ScratchPad DrawRect := rect SetupScratchContexts() end procedure EndDraw() &window := ScratchPadOldWin SetupScreenContexts() CopyArea(ScratchPad,&window,DrawRect.x1,DrawRect.y1,DrawRect.width,DrawRect.height, DrawRect.x1,DrawRect.y1) end procedure ReDraw(t) local oldlist,curwin local spygui,reggui local rect,parent,count spygui := GetSpyGuiInfo(t) reggui := GetSpyderRegion(t) rect := reggui.rect #write("REDRAW!: guiobjdb's size is ",*spygui.GuiObjDB) if (count := *spygui.GuiObjDB) > 0 then CalcAngleInc(spygui,count) spygui.GuiObjDB := table() # new table please BeginDraw(rect) EraseArea(rect.x1,rect.y1,rect.width,rect.height) InitCoordInfo(spygui) oldlist := GetOrderList(t) spygui.LineDB := table() spygui.Segments := table(0) # WZ mod 4/27 every k := key(t) do StructDB[k].keyguiinfo := &null # remove all graphic info # WZ end every k := !oldlist do { # write("src: ",k.src," des: ",k.des) GAddTableLink(t,k.src,k.des,1) } # write("inside Redrawing, calling ShowAllDetailObjs") #ShowAllDetailObjs() EndDraw() ShowUsedRect(rect) end procedure ArrowHead(frpoint,topoint,angle,len) local theta local radius local np1,np2,dx,dy dx := topoint.x - frpoint.x dy := topoint.y - frpoint.y radius := sqrt(dx*dx + dy*dy) if dx = 0 then { if dy > 0 then theta := 90 else theta := -90 } else theta := atan(real(dy), real(dx)) /angle := dtor(20) /len := ArrowLength # radius - 5 np1 := POINT(topoint.x-cos(theta-angle)*len,topoint.y-sin(theta-angle)*len) np2 := POINT(topoint.x-cos(theta+angle)*len,topoint.y-sin(theta+angle)*len) #write("NP1 is ",np1.x,":",np1.y) #write("NP2 is ",np2.x,":",np2.y) DrawLine(ArrowContext,np1.x,np1.y,topoint.x,topoint.y) DrawLine(ArrowContext,np2.x,np2.y,topoint.x,topoint.y) end