In the previous issue, I released GraphEditor using Mathematica's object-oriented programming. This time, I present a new version that adds the ability to select groups to move multiple nodes in a graph.
This GraphEditor ver.2 is a restructured version of the previous version that includes OOP, Dynamic, and EventHandler mechanisms. Complex graphs can be easily created by simply clicking and dragging the mouse on the canvas, without involving adjacent matrices.
Unfortunately, however, the code is still very complex and cumbersome, as a step-by-step development methodology has not been established.
For example, I am still considering whether it would be effective to present a skeleton of the code and develop from this skeleton to the actual code.
Below is my GraphEditor ver.2 code, the main usage of which is the same as the previous version. To select multiple nodes, drag the mouse from the blank area of the canvas, the color of the nodes will change, and drag one of the nodes in this group to move it.
(* board *)
boardRatio = 1.4;
boardImageScale = 800;
f = False;
targetList = {};
namList = {};
boardDisable = False;
area = {};
selected = {};
unselctedColor = LightGray;
selctedColor = Gray;
myStyle = {Medium, FontFamily -> "Helvetica"};
localFileName = "graph";
(* graphics-node-class *)
node[nam_] := Module[
{pos,
boxSize,
textInputMode = False,
title = Null,
(*textInputMode=False,*)
bgColor = unselctedColor,
arrowLine = {},(* arrow leader *)
arrowPointList = {},
targetArrowList = {}
},
getTextInputMode[nam] := textInputMode;
setTextInputMode[nam[tf_]] := textInputMode = tf;
nodePosMove[nam[y_]] := (pos += y);
(*MessageDialog[{nam,textInputMode,boardDisable}];*)
(* graphics-
arrow-sub-class *)
arrowImage[nam[pointName_]] := Module[{
delta,
bsize,
tpos,
arrowDrawback = 0},
EventHandler[
(delta = Abs[pos - (tpos = (nodePosGet[pointName]))];
bsize = 0.4*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, nodePosGet[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]]]
);
nodePosSet[nam[x_]] := (pos = x);
nodePosGet[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;
getBGcolor[nam] := bgColor;
setBGcolor[nam[color_]] := bgColor = color;
setBGcolorSelected[nam] := bgColor = Gray;
setBGcolorUnselected[nam] := bgColor = LightGray;
nodeModifier[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}],
(* Event handler makes new text-box *)
bgc = getBGcolor[nam];(* MessageDialog[{nam,bgc}];*)
EventHandler[
Text[Framed[title, FrameMargins -> 5, BaseStyle -> myStyle],
Dynamic[pos], Background -> Dynamic[getBGcolor[nam]]],
{"MouseDragged" :> Switch[
CurrentValue["OptionKey"],
True, (arrowLine =
Line[{nodePosGet[nam], MousePosition["Graphics"]}]),
False,
(prevPos = pos;
pos = MousePosition["Graphics"];
delta = pos - prevPos;
Map[nodePosMove[#[delta]] &, Cases[selected, Except[nam]]]
)
],(* end of if-current value *)
"MouseClicked" :> Which[
CurrentValue["CommandKey"], removeInst[nam],
CurrentValue["ShiftKey"], (textInputMode = True;
boardDisable = True)],
"MouseMoved" :> (pointName = nam; probe[$x[{mM, nam}]]),(*
get the name of another instance because mouse moved in the \
Text-region *)
"MouseUp" :> Which[
CurrentValue["OptionKey"],
(arrowLine = {}; probe[$x[{Up, nam, pointName}]];
boxArrowPointList[nam[pointName]];(*
append point to the list *)
(*
overide arrow instances *)
targetArrowList :=
Map[arrowImage[nam[#]] &, arrowPointList] ),
True, arrowLine = {}(* safety eraser *)
],(*
end of which *)
}, PassEventsUp -> False](*
end of event-handler *)
}(* end of graphics *)
];(*
end of which text-input-mode *)
buildUpArrowList[nam] :=
targetArrowList := Map[arrowImage[nam[#]] &, arrowPointList]
]; (* end of node-class *)
(* function to make node-instance with unique name *)
makeInst[newPos_] := (
newName = Unique[];
node[newName];(* make new node instance *)
nodePosSet[newName[newPos]];(* pop-up the instance on the board *)
boxSizeSet[
newName[ImageDimensions@
Rasterize@Text@Framed[Null, BaseStyle -> myStyle]]];
AppendTo[namList, newName];
targetList := Map[nodeModifier, namList](* makeup graphics *)
);
(* function to remove node-instance *)
removeInst[name_] :=
(boardDisable = False;
namList = Delete[namList, Position[namList, name][[1]]];
targetList = Map[nodeModifier, namList]);
imageObject := (
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,
nodePosGet, boxSizeGet}], localFileName];
DialogReturn[]],
Button["Load", buildUp[Get[localFileName]];
DialogReturn[]]}
], ImageMargins -> 5], Modal -> True,
WindowTitle -> "objects"];
boardDisable == False,
True, makeInst[MousePosition["Graphics"]]
],(* end of Which & MouseClicked *)
"MouseDown" :> (bCorner = MousePosition["Graphics"];
),
"MouseDragged" :>
(area = {EdgeForm[Dashed], Transparent,
Rectangle[bCorner, sCorner = MousePosition["Graphics"]]};
Map[
If[RegionMember[order[bCorner, sCorner], nodePosGet[#]],
setBGcolor[#[Gray]], setBGcolor[#[LightGray]]] &, namList];
selected = Select[namList, getBGcolor[#] == selctedColor &];
),
"MouseUp" :> (area = {}),
PassEventsUp -> False](*
end of EventHandler *)
]);(* end of imageObject graphics *)
order[b_, s_] := (
{x, y} = Transpose[{b, s}];
Apply[Rectangle, Transpose[{Sort[x], Sort[y]}]]
)
(* build up graphics from file *)
buildUp[{namListX_, boxAPList_, boxTitle_, boxPos_, boxSize_}] := (
Apply[Clear, namList = Flatten@namListX];
targetList = {};
Map[node, namList];
MapThread[nodePosSet[#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[nodeModifier, namList];
boardDisable = False;
);
boardGraphics =
Graphics[Dynamic[{area, targetList}],
PlotRange -> {{0, boardRatio}, {0, 1.}},
ImageSize -> {boardRatio, 1}*boardImageScale];
To prepare a canvas,
boardDisable = False;
SetDirectory[NotebookDirectory[]];
Framed@Deploy@Dynamic[imageObject]
Following is a sample of composed graph of partial Tokyo Highway, named Syutoko.
Saved data can be easily converted to Mathematica's graph format. Please refer to the previous version.
