GraphEditor[] is a tool for Graph editing. You can create a new and a complex graph. This new version resolved the issue on the program part using Event function.
GraphEditor shows that Mathematica event handling system is very useful and strong with OOP.
Object-Oriented-Programming(OOP) in Mathematica is a pathway to make an easy handling method for large number of targets that.
This GraphEditor program can
- make named vertex and arrows connecting with other vertices
- move objects around the board
- delete vertices and arrows
- save and load the graph
- convert to a Mathematica graph.
You can view a sample movie here.
Source code is here.
(* board *)
Module[{boardGraphics,
boardRatio = 1.4,
boardImageScale = 800,
boardDisable = False,
myStyle = {Medium, FontFamily -> "Helvetica"}},
(* graphics-box-class *)
box[nam_] := Module[{
textInputMode = False,
pos,
boxSize,
title = Null,
arrowLine = {},(* arrow leader *)
arrowPointList = {},
targetArrowList = {}},(* arrows graphics *)
(* graphics-arrow-class *)
arrowImage[nam[pointName_]] ^:= Module[{
delta,
bsize,
tpos,
arrowDrawback = 0},
EventHandler[(
delta = Abs[pos - (tpos = (boxPosGet[pointName]))];
bsize =
0.5*boxSizeGet[pointName]/(boardRatio*boardImageScale);
If[delta != {0, 0},
arrowDrawback =
Norm[delta]*If[Apply[ArcTan, delta] > Apply[ArcTan, bsize],
Abs[bsize[[2]]/delta[[2]]],
Abs[bsize[[1]]/delta[[1]]]]];
;
{Arrowheads[Medium],
Arrow[{pos, boxPosGet[pointName]}, {0, arrowDrawback}]}),
{"MouseClicked" :>
If[CurrentValue["CommandKey"],
boxArrowPointDelete[nam[pointName]]]
}, PassEventsUp -> False]
];(* end of arrow class *)
boxArrowPointList[nam[pointName_]] ^:=
AppendTo[arrowPointList, pointName];
boxArrowPointDelete[nam[pointName_]] ^:= (
arrowPointList =
Delete[arrowPointList,
Position[arrowPointList, pointName][[1]]]
);
boxPosSet[nam[x_]] ^:= (pos = x);
boxPosGet[nam] ^:= pos;
boxTitleSet[nam[x_]] ^:= title = x;
boxTitleGet[nam] ^:= title;
boxAPListSet[nam[x_]] ^:= arrowPointList = x;
boxAPListGet[nam] ^:= arrowPointList;
boxSizeSet[nam[x_]] ^:= boxSize = x;
boxSizeGet[nam] ^:= boxSize;
boxBoth[nam] ^:=
Which[
textInputMode == True,
(* graphics of text-input-
mode *)
{arrowLine, targetArrowList,
Text[
EventHandler[
InputField[Dynamic[title], String, FieldSize -> Small
, BaseStyle -> myStyle],
{"MouseEntered" :> None,
"DownArrowKeyDown" :> Paste["\n"],
"ReturnKeyDown" :> (boardDisable = False;
textInputMode = False;
boxSizeSet[
nam[ImageDimensions@
Rasterize@
Text@Framed[title, FrameMargins -> 5,
BaseStyle -> myStyle]]])
}, PassEventsUp -> False], pos]},
textInputMode == False,(* graphics-
mode *)
{Dynamic[{arrowLine, targetArrowList}],
EventHandler[
Text[Framed[title, FrameMargins -> 5, BaseStyle -> myStyle],
Dynamic[pos], Background -> LightGray],
{"MouseDragged" :> Switch[CurrentValue["OptionKey"],
True, (arrowLine =
Line[{boxPosGet[nam], MousePosition["Graphics"]}]),
False, (pos = MousePosition["Graphics"])
],(* end of if-current value *)
"MouseClicked" :>
Which[probe[$x[{nam, boardDisable}]]; (*
OOP probe program hook line *)
CurrentValue["CommandKey"], removeInst[nam],
CurrentValue["ShiftKey"], textInputMode = True;
boardDisable = True],
"MouseMoved" :> (pointName = nam),(*
get the name of another instance *)
"MouseUp" :> Which[
CurrentValue["OptionKey"],
(arrowLine = {};
boxArrowPointList[nam[pointName]];(*
append point to the list *)
(*
overide arrow instances *)
targetArrowList :=
Map[arrowImage[nam[#]] &, arrowPointList]),
True, arrowLine = {}(* safety eraser *)
],(*
end of if-shift-key *)
PassEventsUp -> False},
PassEventsUp -> False](* end of event-handler *)
}(*
end of graphics *)
];(* end of text-input-mode *)
buildUpArrowList[nam] ^:=
targetArrowList := Map[arrowImage[nam[#]] &, arrowPointList]
]; (* end of box-class *)
(* function to make box-instance with unique name *)
makeInst[newPos_] := (
newName = Unique[];
box[newName];(* make new box instance *)
boxPosSet[newName[newPos]];(* pop-up the instance on the board *)
boxSizeSet[
newName[ImageDimensions@
Rasterize@Text@Framed[Null, BaseStyle -> myStyle]]];
AppendTo[namList, newName];
targetList := Map[boxBoth, namList](* makeup graphics *)
);
(* function to remove box-instance *)
removeInst[
boxName_] :=
(namList =
Delete[namList, Position[namList, boxName][[1]]];
targetList = Map[boxBoth, namList]);
boardGraphics =
Graphics[Dynamic[targetList],
PlotRange -> {{0, boardRatio}, {0, 1.}},
ImageSize -> {boardRatio, 1}*boardImageScale];
delegate := (
Which[boardDisable == True, boardGraphics,
boardDisable == False, EventHandler[boardGraphics,
"MouseClicked" :> Which[
CurrentValue["OptionKey"] == True,
CreateDialog[
Pane[Column[{Button["Save",
Put[Map[
Map[#, namList] &, {List, boxAPListGet, boxTitleGet,
boxPosGet, boxSizeGet}], "graph"]; DialogReturn[]],
Button["Load", buildUp[Get["graph"]]; DialogReturn[]]}
], ImageMargins -> 5], Modal -> True,
WindowTitle -> "objects"]; boardDisable == False,
True, makeInst[MousePosition["Graphics"]]
], PassEventsUp -> False](*
end of EventHandler *)
]);(* end of delegate graphics *)
(* build up graphics from file *)
buildUp[{namListX_, boxAPList_, boxTitle_, boxPos_, boxSize_}] := (
Apply[Clear, namList = Flatten@namListX];
targetList = {};
Map[box, namList];
MapThread[boxPosSet[#1[#2]] &, {namList, boxPos}];
MapThread[boxSizeSet[#1[#2]] &, {namList, boxSize}];
MapThread[boxTitleSet[#1[#2]] &, {namList, boxTitle}];
MapThread[boxAPListSet[#1[#2]] &, {namList, boxAPList}];
Map[buildUpArrowList, namList];
Flatten@ReleaseHold[
MapThread[f[#1, #2] &, {namList, boxAPList}] /.
f[nam_, p_] -> Hold@Map[boxArrowPointList[nam, #] &, p]];
targetList = Map[boxBoth, namList];
boardDisable = False
);
](* end of Module *)
To start the program,
targetList = {}; namList = {};
SetDirectory[NotebookDirectory[]];
Framed@Deploy@Dynamic@delegate
then, you can see the blank board.
Usage is as follows.
Board area: Click makes text-box, and with Option-key Click shows menu for data save to a file and load data from a file.
Text-box: Drag moves text-box around with Shift-key Click move into the title input mode, and Return-key move out to the graphics mode with Command-key Click deletes text-box with Option-key Drag the mouse into another text-box make connection with an arrow
Arrow: with Command-key Click deletes arrow
Following is a sample code for saved data converter to the Mathematica Graph data.
g = Get["graph"][[1 ;; 3]]; (* read the file *)
f[t_] := Map[Rule[t[[1]], #] &, t[[2]]]; (* define rule function *)
gl1 = Flatten@
Map[f, Transpose[{Flatten[g[[1]]],
g[[2]]}]]; (* construct vertex list of graph *)
gl1 = gl1 /.
Rule[x_, y_] /; x == y -> Nothing; (* remove self loop *)
gl2 = Map[Rule[#[[1, 1]], #[[2]]] &,
Transpose[{g[[1]],
g[[3]]}]];(* construct label list of graph *)
gg =
Graph[gl1, VertexLabels -> gl2, ImagePadding -> 50,
GraphLayout -> "SpringEmbedding"]
Unfortunately, the number of vertex labels may be limited, you may chose the labels, and can get a graph converted from the GraphEditor file.