Fri Feb 3 15:05:30 WET 2006 Miguel Vilaca <jmvilaca@di.uminho.pt>
* Rules edition
It chances the data-type to provide support for a set of rules. Each rule has a Left Hand Side and a Right Hand Side with each one been a network. Additionally each rule has a name and a mapping which is a bijection between interface nodes in the LHS and interface nodes in the RHS of the same rule. This is represented by a set of pairs.
This patch also introduces the graphical elements to allow the set of rules.
{
hunk ./NatExample.INblobs 1
-<Network[_^M_][_$_]
- ><Width[_^M_][_$_]
- >15.0</Width[_^M_][_$_]
- ><Height[_^M_][_$_]
- >9.0</Height[_^M_][_$_]
- ><Info[_^M_][_$_]
- ><unit/></Info[_^M_][_$_]
- ><Palette[_^M_][_$_]
- ><Palette[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[interface]]></string[_^M_][_$_]
- ><Circle[_^M_][_$_]
- ><ShapeStyle[_^M_][_$_]
- ><int value="2"[_^M_][_$_]
- /><RGB[_^M_][_$_]
- ><int value="255"[_^M_][_$_]
- /><int value="255"[_^M_][_$_]
- /><int value="255"/></RGB[_^M_][_$_]
- ><RGB[_^M_][_$_]
- ><int value="255"[_^M_][_$_]
- /><int value="255"[_^M_][_$_]
- /><int value="255"/></RGB></ShapeStyle[_^M_][_$_]
- ><double value="0.25"/></Circle[_^M_][_$_]
- ><maybe-list-tuple2-string-DoublePoint[_^M_][_$_]
- ><list-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[down]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.25</Y></list-tuple2-string-DoublePoint></maybe-list-tuple2-string-DoublePoint[_^M_][_$_]
- ><maybe-list-int[_^M_][_$_]
- ><list-int/></maybe-list-int[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[A]]></string[_^M_][_$_]
- ><Composite[_^M_][_$_]
- ><list-Shape[_^M_][_$_]
- ><Circle[_^M_][_$_]
- ><ShapeStyle[_^M_][_$_]
- ><int value="2"[_^M_][_$_]
- /><RGB[_^M_][_$_]
- ><int value="250"[_^M_][_$_]
- /><int value="0"[_^M_][_$_]
- /><int value="0"/></RGB[_^M_][_$_]
- ><RGB[_^M_][_$_]
- ><int value="255"[_^M_][_$_]
- /><int value="255"[_^M_][_$_]
- /><int value="255"/></RGB></ShapeStyle[_^M_][_$_]
- ><double value="0.5"/></Circle[_^M_][_$_]
- ><Lines[_^M_][_$_]
- ><ShapeStyle[_^M_][_$_]
- ><int value="2"[_^M_][_$_]
- /><RGB[_^M_][_$_]
- ><int value="250"[_^M_][_$_]
- /><int value="0"[_^M_][_$_]
- /><int value="0"/></RGB[_^M_][_$_]
- ><RGB[_^M_][_$_]
- ><int value="128"[_^M_][_$_]
- /><int value="128"[_^M_][_$_]
- /><int value="128"/></RGB></ShapeStyle[_^M_][_$_]
- ><list-DoublePoint[_^M_][_$_]
- ><X[_^M_][_$_]
- >-0.25</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.25</Y[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >-0.35</Y[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.25</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.25</Y></list-DoublePoint></Lines[_^M_][_$_]
- ><Lines[_^M_][_$_]
- ><ShapeStyle[_^M_][_$_]
- ><int value="2"[_^M_][_$_]
- /><RGB[_^M_][_$_]
- ><int value="250"[_^M_][_$_]
- /><int value="0"[_^M_][_$_]
- /><int value="0"/></RGB[_^M_][_$_]
- ><RGB[_^M_][_$_]
- ><int value="128"[_^M_][_$_]
- /><int value="128"[_^M_][_$_]
- /><int value="128"/></RGB></ShapeStyle[_^M_][_$_]
- ><list-DoublePoint[_^M_][_$_]
- ><X[_^M_][_$_]
- >-0.2</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.1</Y[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.2</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.1</Y></list-DoublePoint></Lines></list-Shape></Composite[_^M_][_$_]
- ><maybe-list-tuple2-string-DoublePoint[_^M_][_$_]
- ><list-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[down]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.5</Y[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[left]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >-0.5</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.0</Y[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[right]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.5</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.0</Y></list-tuple2-string-DoublePoint></maybe-list-tuple2-string-DoublePoint[_^M_][_$_]
- ><maybe-list-int[_^M_][_$_]
- ><list-int/></maybe-list-int[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[Z]]></string[_^M_][_$_]
- ><Composite[_^M_][_$_]
- ><list-Shape[_^M_][_$_]
- ><Circle[_^M_][_$_]
- ><ShapeStyle[_^M_][_$_]
- ><int value="2"[_^M_][_$_]
- /><RGB[_^M_][_$_]
- ><int value="250"[_^M_][_$_]
- /><int value="0"[_^M_][_$_]
- /><int value="0"/></RGB[_^M_][_$_]
- ><RGB[_^M_][_$_]
- ><int value="255"[_^M_][_$_]
- /><int value="255"[_^M_][_$_]
- /><int value="255"/></RGB></ShapeStyle[_^M_][_$_]
- ><double value="0.5"/></Circle[_^M_][_$_]
- ><Lines[_^M_][_$_]
- ><ShapeStyle[_^M_][_$_]
- ><int value="2"[_^M_][_$_]
- /><RGB[_^M_][_$_]
- ><int value="250"[_^M_][_$_]
- /><int value="0"[_^M_][_$_]
- /><int value="0"/></RGB[_^M_][_$_]
- ><RGB[_^M_][_$_]
- ><int value="128"[_^M_][_$_]
- /><int value="128"[_^M_][_$_]
- /><int value="128"/></RGB></ShapeStyle[_^M_][_$_]
- ><list-DoublePoint[_^M_][_$_]
- ><X[_^M_][_$_]
- >-0.25</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >-0.25</Y[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.25</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >-0.25</Y[_^M_][_$_]
- ><X[_^M_][_$_]
- >-0.25</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.25</Y[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.25</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.25</Y></list-DoublePoint></Lines[_^M_][_$_]
- ><Lines[_^M_][_$_]
- ><ShapeStyle[_^M_][_$_]
- ><int value="2"[_^M_][_$_]
- /><RGB[_^M_][_$_]
- ><int value="250"[_^M_][_$_]
- /><int value="0"[_^M_][_$_]
- /><int value="0"/></RGB[_^M_][_$_]
- ><RGB[_^M_][_$_]
- ><int value="128"[_^M_][_$_]
- /><int value="128"[_^M_][_$_]
- /><int value="128"/></RGB></ShapeStyle[_^M_][_$_]
- ><list-DoublePoint[_^M_][_$_]
- ><X[_^M_][_$_]
- >-0.15</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.0</Y[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.15</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.0</Y></list-DoublePoint></Lines></list-Shape></Composite[_^M_][_$_]
- ><maybe-list-tuple2-string-DoublePoint[_^M_][_$_]
- ><list-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[down]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.5</Y></list-tuple2-string-DoublePoint></maybe-list-tuple2-string-DoublePoint[_^M_][_$_]
- ><maybe-list-int[_^M_][_$_]
- ><list-int/></maybe-list-int[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[S]]></string[_^M_][_$_]
- ><Composite[_^M_][_$_]
- ><list-Shape[_^M_][_$_]
- ><Circle[_^M_][_$_]
- ><ShapeStyle[_^M_][_$_]
- ><int value="2"[_^M_][_$_]
- /><RGB[_^M_][_$_]
- ><int value="250"[_^M_][_$_]
- /><int value="0"[_^M_][_$_]
- /><int value="0"/></RGB[_^M_][_$_]
- ><RGB[_^M_][_$_]
- ><int value="255"[_^M_][_$_]
- /><int value="255"[_^M_][_$_]
- /><int value="255"/></RGB></ShapeStyle[_^M_][_$_]
- ><double value="0.5"/></Circle[_^M_][_$_]
- ><Lines[_^M_][_$_]
- ><ShapeStyle[_^M_][_$_]
- ><int value="2"[_^M_][_$_]
- /><RGB[_^M_][_$_]
- ><int value="250"[_^M_][_$_]
- /><int value="0"[_^M_][_$_]
- /><int value="0"/></RGB[_^M_][_$_]
- ><RGB[_^M_][_$_]
- ><int value="128"[_^M_][_$_]
- /><int value="128"[_^M_][_$_]
- /><int value="128"/></RGB></ShapeStyle[_^M_][_$_]
- ><list-DoublePoint[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.25</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >-0.25</Y[_^M_][_$_]
- ><X[_^M_][_$_]
- >-0.25</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >-0.25</Y[_^M_][_$_]
- ><X[_^M_][_$_]
- >-0.25</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.0</Y[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.25</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.0</Y[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.25</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.25</Y[_^M_][_$_]
- ><X[_^M_][_$_]
- >-0.25</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.25</Y></list-DoublePoint></Lines></list-Shape></Composite[_^M_][_$_]
- ><maybe-list-tuple2-string-DoublePoint[_^M_][_$_]
- ><list-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[down]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.5</Y[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[up]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >-0.5</Y></list-tuple2-string-DoublePoint></maybe-list-tuple2-string-DoublePoint[_^M_][_$_]
- ><maybe-list-int[_^M_][_$_]
- ><list-int/></maybe-list-int></Palette></Palette[_^M_][_$_]
- ><Nodes[_^M_][_$_]
- ><Node id="N1"[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.635</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >2.3018750000000003</Y[_^M_][_$_]
- ><Name[_^M_][_$_]
- ><![CDATA[Node 1]]></Name[_^M_][_$_]
- ><LabelAbove[_^M_][_$_]
- >True</LabelAbove[_^M_][_$_]
- ><Shape[_^M_][_$_]
- ><Left-string[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[Z]]></string></Left-string></Shape[_^M_][_$_]
- ><Ports[_^M_][_$_]
- ><maybe-list-tuple2-string-DoublePoint[_^M_][_$_]
- ><list-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[down]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.5</Y></list-tuple2-string-DoublePoint></maybe-list-tuple2-string-DoublePoint></Ports[_^M_][_$_]
- ><Info[_^M_][_$_]
- ><list-int/></Info></Node[_^M_][_$_]
- ><Node id="N2"[_^M_][_$_]
- ><X[_^M_][_$_]
- >6.0325</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >2.3018750000000003</Y[_^M_][_$_]
- ><Name[_^M_][_$_]
- ><![CDATA[Node 2]]></Name[_^M_][_$_]
- ><LabelAbove[_^M_][_$_]
- >True</LabelAbove[_^M_][_$_]
- ><Shape[_^M_][_$_]
- ><Left-string[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[Z]]></string></Left-string></Shape[_^M_][_$_]
- ><Ports[_^M_][_$_]
- ><maybe-list-tuple2-string-DoublePoint[_^M_][_$_]
- ><list-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[down]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.5</Y></list-tuple2-string-DoublePoint></maybe-list-tuple2-string-DoublePoint></Ports[_^M_][_$_]
- ><Info[_^M_][_$_]
- ><list-int/></Info></Node[_^M_][_$_]
- ><Node id="N3"[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.635</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >4.709583333333335</Y[_^M_][_$_]
- ><Name[_^M_][_$_]
- ><![CDATA[Node 3]]></Name[_^M_][_$_]
- ><LabelAbove[_^M_][_$_]
- >True</LabelAbove[_^M_][_$_]
- ><Shape[_^M_][_$_]
- ><Left-string[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[S]]></string></Left-string></Shape[_^M_][_$_]
- ><Ports[_^M_][_$_]
- ><maybe-list-tuple2-string-DoublePoint[_^M_][_$_]
- ><list-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[down]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.5</Y[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[up]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >-0.5</Y></list-tuple2-string-DoublePoint></maybe-list-tuple2-string-DoublePoint></Ports[_^M_][_$_]
- ><Info[_^M_][_$_]
- ><list-int/></Info></Node[_^M_][_$_]
- ><Node id="N4"[_^M_][_$_]
- ><X[_^M_][_$_]
- >6.032500000000001</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >4.736041666666667</Y[_^M_][_$_]
- ><Name[_^M_][_$_]
- ><![CDATA[Node 4]]></Name[_^M_][_$_]
- ><LabelAbove[_^M_][_$_]
- >True</LabelAbove[_^M_][_$_]
- ><Shape[_^M_][_$_]
- ><Left-string[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[S]]></string></Left-string></Shape[_^M_][_$_]
- ><Ports[_^M_][_$_]
- ><maybe-list-tuple2-string-DoublePoint[_^M_][_$_]
- ><list-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[down]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.5</Y[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[up]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >-0.5</Y></list-tuple2-string-DoublePoint></maybe-list-tuple2-string-DoublePoint></Ports[_^M_][_$_]
- ><Info[_^M_][_$_]
- ><list-int/></Info></Node[_^M_][_$_]
- ><Node id="N5"[_^M_][_$_]
- ><X[_^M_][_$_]
- >2.4341666666666666</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >4.709583333333334</Y[_^M_][_$_]
- ><Name[_^M_][_$_]
- ><![CDATA[Node 5]]></Name[_^M_][_$_]
- ><LabelAbove[_^M_][_$_]
- >True</LabelAbove[_^M_][_$_]
- ><Shape[_^M_][_$_]
- ><Left-string[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[A]]></string></Left-string></Shape[_^M_][_$_]
- ><Ports[_^M_][_$_]
- ><maybe-list-tuple2-string-DoublePoint[_^M_][_$_]
- ><list-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[down]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.5</Y[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[left]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >-0.5</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.0</Y[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[right]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.5</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.0</Y></list-tuple2-string-DoublePoint></maybe-list-tuple2-string-DoublePoint></Ports[_^M_][_$_]
- ><Info[_^M_][_$_]
- ><list-int/></Info></Node[_^M_][_$_]
- ><Node id="N6"[_^M_][_$_]
- ><X[_^M_][_$_]
- >7.858125</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >4.736041666666667</Y[_^M_][_$_]
- ><Name[_^M_][_$_]
- ><![CDATA[Node 6]]></Name[_^M_][_$_]
- ><LabelAbove[_^M_][_$_]
- >True</LabelAbove[_^M_][_$_]
- ><Shape[_^M_][_$_]
- ><Left-string[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[A]]></string></Left-string></Shape[_^M_][_$_]
- ><Ports[_^M_][_$_]
- ><maybe-list-tuple2-string-DoublePoint[_^M_][_$_]
- ><list-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[down]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.5</Y[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[left]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >-0.5</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.0</Y[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[right]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.5</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.0</Y></list-tuple2-string-DoublePoint></maybe-list-tuple2-string-DoublePoint></Ports[_^M_][_$_]
- ><Info[_^M_][_$_]
- ><list-int/></Info></Node[_^M_][_$_]
- ><Node id="N7"[_^M_][_$_]
- ><X[_^M_][_$_]
- >1.9314583333333335</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >1.2435416666666668</Y[_^M_][_$_]
- ><Name[_^M_][_$_]
- ><![CDATA[Node 7]]></Name[_^M_][_$_]
- ><LabelAbove[_^M_][_$_]
- >True</LabelAbove[_^M_][_$_]
- ><Shape[_^M_][_$_]
- ><Left-string[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[interface]]></string></Left-string></Shape[_^M_][_$_]
- ><Ports[_^M_][_$_]
- ><maybe-list-tuple2-string-DoublePoint[_^M_][_$_]
- ><list-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[down]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.25</Y></list-tuple2-string-DoublePoint></maybe-list-tuple2-string-DoublePoint></Ports[_^M_][_$_]
- ><Info[_^M_][_$_]
- ><list-int/></Info></Node[_^M_][_$_]
- ><Node id="N8"[_^M_][_$_]
- ><X[_^M_][_$_]
- >8.334375000000001</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >1.2699999999999998</Y[_^M_][_$_]
- ><Name[_^M_][_$_]
- ><![CDATA[Node 8]]></Name[_^M_][_$_]
- ><LabelAbove[_^M_][_$_]
- >True</LabelAbove[_^M_][_$_]
- ><Shape[_^M_][_$_]
- ><Left-string[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[interface]]></string></Left-string></Shape[_^M_][_$_]
- ><Ports[_^M_][_$_]
- ><maybe-list-tuple2-string-DoublePoint[_^M_][_$_]
- ><list-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[down]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.25</Y></list-tuple2-string-DoublePoint></maybe-list-tuple2-string-DoublePoint></Ports[_^M_][_$_]
- ><Info[_^M_][_$_]
- ><list-int/></Info></Node></Nodes[_^M_][_$_]
- ><Edges[_^M_][_$_]
- ><Edge id="E1"[_^M_][_$_]
- ><From[_^M_][_$_]
- >7</From[_^M_][_$_]
- ><PortFrom[_^M_][_$_]
- ><maybe-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[down]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.25</Y></maybe-tuple2-string-DoublePoint></PortFrom[_^M_][_$_]
- ><To[_^M_][_$_]
- >5</To[_^M_][_$_]
- ><PortTo[_^M_][_$_]
- ><maybe-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[left]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >-0.5</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.0</Y></maybe-tuple2-string-DoublePoint></PortTo[_^M_][_$_]
- ><Via[_^M_][_$_]
- /><Info[_^M_][_$_]
- ><list-int/></Info></Edge[_^M_][_$_]
- ><Edge id="E2"[_^M_][_$_]
- ><From[_^M_][_$_]
- >8</From[_^M_][_$_]
- ><PortFrom[_^M_][_$_]
- ><maybe-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[down]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.25</Y></maybe-tuple2-string-DoublePoint></PortFrom[_^M_][_$_]
- ><To[_^M_][_$_]
- >6</To[_^M_][_$_]
- ><PortTo[_^M_][_$_]
- ><maybe-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[right]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.5</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.0</Y></maybe-tuple2-string-DoublePoint></PortTo[_^M_][_$_]
- ><Via[_^M_][_$_]
- /><Info[_^M_][_$_]
- ><list-int/></Info></Edge[_^M_][_$_]
- ><Edge id="E3"[_^M_][_$_]
- ><From[_^M_][_$_]
- >5</From[_^M_][_$_]
- ><PortFrom[_^M_][_$_]
- ><maybe-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[right]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.5</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.0</Y></maybe-tuple2-string-DoublePoint></PortFrom[_^M_][_$_]
- ><To[_^M_][_$_]
- >6</To[_^M_][_$_]
- ><PortTo[_^M_][_$_]
- ><maybe-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[left]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >-0.5</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.0</Y></maybe-tuple2-string-DoublePoint></PortTo[_^M_][_$_]
- ><Via[_^M_][_$_]
- ><X[_^M_][_$_]
- >2.9104166666666673</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >1.6668749999999999</Y[_^M_][_$_]
- ><X[_^M_][_$_]
- >7.355416666666667</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >1.6668749999999999</Y></Via[_^M_][_$_]
- ><Info[_^M_][_$_]
- ><list-int/></Info></Edge[_^M_][_$_]
- ><Edge id="E4"[_^M_][_$_]
- ><From[_^M_][_$_]
- >1</From[_^M_][_$_]
- ><PortFrom[_^M_][_$_]
- ><maybe-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[down]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.5</Y></maybe-tuple2-string-DoublePoint></PortFrom[_^M_][_$_]
- ><To[_^M_][_$_]
- >3</To[_^M_][_$_]
- ><PortTo[_^M_][_$_]
- ><maybe-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[up]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >-0.5</Y></maybe-tuple2-string-DoublePoint></PortTo[_^M_][_$_]
- ><Via[_^M_][_$_]
- /><Info[_^M_][_$_]
- ><list-int/></Info></Edge[_^M_][_$_]
- ><Edge id="E5"[_^M_][_$_]
- ><From[_^M_][_$_]
- >2</From[_^M_][_$_]
- ><PortFrom[_^M_][_$_]
- ><maybe-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[down]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.5</Y></maybe-tuple2-string-DoublePoint></PortFrom[_^M_][_$_]
- ><To[_^M_][_$_]
- >4</To[_^M_][_$_]
- ><PortTo[_^M_][_$_]
- ><maybe-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[up]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >-0.5</Y></maybe-tuple2-string-DoublePoint></PortTo[_^M_][_$_]
- ><Via[_^M_][_$_]
- /><Info[_^M_][_$_]
- ><list-int/></Info></Edge[_^M_][_$_]
- ><Edge id="E6"[_^M_][_$_]
- ><From[_^M_][_$_]
- >3</From[_^M_][_$_]
- ><PortFrom[_^M_][_$_]
- ><maybe-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[down]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.5</Y></maybe-tuple2-string-DoublePoint></PortFrom[_^M_][_$_]
- ><To[_^M_][_$_]
- >5</To[_^M_][_$_]
- ><PortTo[_^M_][_$_]
- ><maybe-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[down]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.5</Y></maybe-tuple2-string-DoublePoint></PortTo[_^M_][_$_]
- ><Via[_^M_][_$_]
- /><Info[_^M_][_$_]
- ><list-int/></Info></Edge[_^M_][_$_]
- ><Edge id="E7"[_^M_][_$_]
- ><From[_^M_][_$_]
- >4</From[_^M_][_$_]
- ><PortFrom[_^M_][_$_]
- ><maybe-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[down]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.5</Y></maybe-tuple2-string-DoublePoint></PortFrom[_^M_][_$_]
- ><To[_^M_][_$_]
- >6</To[_^M_][_$_]
- ><PortTo[_^M_][_$_]
- ><maybe-tuple2-string-DoublePoint[_^M_][_$_]
- ><string[_^M_][_$_]
- ><![CDATA[down]]></string[_^M_][_$_]
- ><X[_^M_][_$_]
- >0.0</X[_^M_][_$_]
- ><Y[_^M_][_$_]
- >0.5</Y></maybe-tuple2-string-DoublePoint></PortTo[_^M_][_$_]
- ><Via[_^M_][_$_]
- /><Info[_^M_][_$_]
- ><list-int/></Info></Edge></Edges></Network>
+
rmfile ./NatExample.INblobs
hunk ./NatIN.INblobpalette 10
- , Just [("down", DoublePoint 0.0 0.25)][_^M_][_$_]
+ , Just [("interface", DoublePoint 0.0 0.25)][_^M_][_$_]
hunk ./src/Constants.hs 23
+kNodeMapColour :: Colour
+kNodeMapColour = darkSlateGray [_$_]
+
hunk ./src/ContextMenu.hs 85
- ; pDoc <- getDocument state
- ; doc <- PD.getDocument pDoc
- ; let network = getNetwork doc
+ ; pDoc <- getDocument state
+ ; doc <- PD.getDocument pDoc
+ ; canvas <- getActiveCanvas state
+ ; let network = selectNetwork doc canvas
hunk ./src/ContextMenu.hs 91
- palette = getPalette network
+ palette = getPalette doc
hunk ./src/DisplayOptions.hs 13
-standard = DP [NodeLabel]
+standard = DP []
hunk ./src/Document.hs 10
+ , RuleName
+ , ActiveCanvas(..) [_$_]
hunk ./src/Document.hs 15
+ , getPalette, setPalette
hunk ./src/Document.hs 17
+ , getRules, setRules
hunk ./src/Document.hs 20
+ , updateRules
+ , selectNetwork
+ , updateSelNetwork, updateSelNetworkEx
+ , removeMappingElemWithNode
+ , show'
hunk ./src/Document.hs 27
-import qualified Network
+import Network hiding (empty)
+import INRule
+import INRules hiding (empty) [_$_]
hunk ./src/Document.hs 33
+import Palette hiding (delete, empty)
+import qualified Network (empty)
+import qualified INRules (empty) [_$_]
+import qualified Palette (empty)
hunk ./src/Document.hs 38
+import Data.Maybe
+
hunk ./src/Document.hs 45
- { docNetwork :: Network.Network g n e
+ { docNetwork :: Network g n e
+ , docPalette :: Palette n -- ^ the current 'Palette'
hunk ./src/Document.hs 48
+ , docRules :: INRules g n e
hunk ./src/Document.hs 51
+type RuleName = String
+data ActiveCanvas = Net | LHS RuleName | RHS RuleName deriving (Show, Eq, Read)
+
hunk ./src/Document.hs 56
- | NodeSelection Int (Maybe Port)
- | EdgeSelection Int
- | ViaSelection Int Int
- | MultipleSelection (Maybe (DoublePoint,DoublePoint)) [Int] [(Int,Int)]
+ | NodeSelection ActiveCanvas Int (Maybe Port)
+ | EdgeSelection ActiveCanvas Int
+ | ViaSelection ActiveCanvas Int Int
+ | MultipleSelection ActiveCanvas [_$_]
+ (Maybe (DoublePoint,DoublePoint)) [Int] [(Int,Int)]
hunk ./src/Document.hs 74
+ , docPalette = Palette.empty
hunk ./src/Document.hs 76
+ , docRules = INRules.empty g n e
hunk ./src/Document.hs 83
-getNetwork :: Document g n e -> Network.Network g n e
+getNetwork :: Document g n e -> Network g n e
+getPalette :: Document g n e -> Palette n
hunk ./src/Document.hs 86
+getRules :: Document g n e -> INRules g n e
hunk ./src/Document.hs 88
-getNetwork doc = docNetwork doc
+getNetwork doc = docNetwork doc
+getPalette doc = docPalette doc
hunk ./src/Document.hs 91
+getRules doc = docRules doc
hunk ./src/Document.hs 99
-setNetwork :: Network.Network g n e -> Document g n e -> Document g n e
+setNetwork :: Network g n e -> Document g n e -> Document g n e
hunk ./src/Document.hs 105
+setPalette :: Palette n -> Document g n e -> Document g n e
+setPalette thePalette doc = doc { docPalette = thePalette }
+
hunk ./src/Document.hs 111
-updateNetwork :: (Network.Network g n e -> Network.Network g n e)
+setRules :: INRules g n e -> Document g n e -> Document g n e
+setRules theRules doc = doc {docRules = theRules}
+
+updateNetwork :: (Network g n e -> Network g n e)
hunk ./src/Document.hs 120
-updateNetworkEx :: (Network.Network g n e -> (b, Network.Network g n e))
+updateNetworkEx :: (Network g n e -> (b, Network g n e))
hunk ./src/Document.hs 128
+updateRules :: (INRules g n e -> INRules g n e) [_$_]
+ -> Document g n e -> Document g n e
+updateRules rulesFun doc = doc { docRules = rulesFun $ docRules doc }
+
hunk ./src/Document.hs 133
-unsafeSetNetwork :: Network.Network g n e -> Document g n e -> Document g n e
+unsafeSetNetwork :: Network g n e -> Document g n e -> Document g n e
hunk ./src/Document.hs 135
+
+-- | Given a document and the active canvas this function selects [_$_]
+-- the corresponding network.
+selectNetwork :: Document g n e -> ActiveCanvas -> Network g n e
+selectNetwork doc canvas =
+ case canvas of
+ Net -> getNetwork doc
+ LHS ruleName -> fromMaybe (erro ruleName)
+ $ getLHS `fromRule` ruleName $ getRules doc
+ RHS ruleName -> fromMaybe (erro ruleName) [_$_]
+ $ getRHS `fromRule` ruleName $ getRules doc
+ where erro ruleName = error $ "This shouldn't happen because «"
+ ++ ruleName ++ "» must be a rule."
+
+-- | Given a document and the active canvas this function updates [_$_]
+-- the corresponding network accordingly the the updater network [_$_]
+-- function given as an argument.
+updateSelNetwork :: (Network g n e -> Network g n e)
+ -> ActiveCanvas -> Document g n e -> Document g n e
+updateSelNetwork netFunc canvas doc =
+ case canvas of [_$_]
+ Net -> updateNetwork netFunc doc
+ LHS ruleName -> updateRules (updateRule ruleName $ updateLHS netFunc) doc
+ RHS ruleName -> updateRules (updateRule ruleName $ updateRHS netFunc) doc
+
+updateSelNetworkEx :: (Network g n e -> (b, Network g n e))
+ -> ActiveCanvas -> Document g n e -> (b, Document g n e)
+updateSelNetworkEx networkFun canvas doc =
+ let (result, newNetwork) = networkFun (selectNetwork doc canvas)
+ in ( result
+ , case canvas of
+ Net -> unsafeSetNetwork newNetwork doc
+ LHS ruleName -> updateRules (updateRule ruleName [_$_]
+ $ setLHS newNetwork) doc
+ RHS ruleName -> updateRules (updateRule ruleName [_$_]
+ $ setRHS newNetwork) doc
+ )
+
+removeMappingElemWithNode :: ActiveCanvas -> NodeNr -> Document g n e -> Document g n e
+removeMappingElemWithNode canv nodeNr = [_$_]
+ case canv of
+ Net -> id
+ LHS rule -> updateRules $ updateRule rule $ updateMapping $ filter $ (/= nodeNr) . fst . fst [_$_]
+ RHS rule -> updateRules $ updateRule rule $ updateMapping $ filter $ (/= nodeNr) . fst . snd [_$_]
+
+show' :: ActiveCanvas -> String
+show' Net = "net"
+show' (LHS rule) = "rule " ++ rule ++ "'s LHS"
+show' (RHS rule) = "rule " ++ rule ++ "'s RHS"
addfile ./src/DocumentFile.hs
hunk ./src/DocumentFile.hs 1
+module DocumentFile where[_^M_][_$_]
+[_^M_][_$_]
+[_^M_][_$_]
+import Document as Doc[_^M_][_$_]
+import Palette[_^M_][_$_]
+import INRule[_^M_][_$_]
+import InfoKind[_^M_][_$_]
+import NetworkFile[_^M_][_$_]
+[_^M_][_$_]
+import Text.XML.HaXml.Posn (noPos)[_^M_][_$_]
+import Text.XML.HaXml.Parse[_^M_][_$_]
+import Text.XML.HaXml.XmlContent as XML[_^M_][_$_]
+import Text.PrettyPrint.HughesPJ[_^M_][_$_]
+import qualified Text.XML.HaXml.Pretty as Pretty[_^M_][_$_]
+[_^M_][_$_]
+[_^M_][_$_]
+-- | Print the document data structure to an XML text[_^M_][_$_]
+toString :: (InfoKind n g, InfoKind e g, XmlContent g) =>[_^M_][_$_]
+ Doc.Document g n e -> String[_^M_][_$_]
+toString doc = render . Pretty.document $[_^M_][_$_]
+ Document (Prolog Nothing [] Nothing []) emptyST (f (toContents doc)) [][_^M_][_$_]
+ where[_^M_][_$_]
+ f [CElem e _] = e[_^M_][_$_]
+ f _ = error "bad" -- shouldn't happen[_^M_][_$_]
+[_^M_][_$_]
+-- | Parses a string to the document data structure[_^M_][_$_]
+-- Returns either an error message (Left) or the document,[_^M_][_$_]
+-- a list of warnings (Right) and a boolean indicating whether[_^M_][_$_]
+-- the file was an old INBlobs file[_^M_][_$_]
+fromString :: (InfoKind n g, InfoKind e g, XmlContent g) =>[_^M_][_$_]
+ String -> Either String (Doc.Document g n e, [String], Bool)[_^M_][_$_]
+fromString xml =[_^M_][_$_]
+ case xmlParse' "input file" xml of[_^M_][_$_]
+ Left err -> Left err -- lexical or initial (generic) parse error[_^M_][_$_]
+ Right (Document _ _ e _) ->[_^M_][_$_]
+ case runParser parseContents [CElem e noPos] of[_^M_][_$_]
+ (Left err, _) -> Left err -- secondary (typeful) parse error[_^M_][_$_]
+ (Right v, _) -> Right (v,[],False)[_^M_][_$_]
+[_^M_][_$_]
+[_^M_][_$_]
+[_^M_][_$_]
+instance HTypeable (Doc.Document g n e) where[_^M_][_$_]
+ toHType _ = Defined "Document" [] [Constr "Document" [] []][_^M_][_$_]
+instance (InfoKind n g, InfoKind e g, XmlContent g) =>[_^M_][_$_]
+ XmlContent (Doc.Document g n e) where[_^M_][_$_]
+ toContents document = [_^M_][_$_]
+ [CElem (Elem "Document" [][_^M_][_$_]
+ [ makeTag "Network" (toContents $ getNetwork document)[_^M_][_$_]
+ , makeTag "Palette" (toContents $ getPalette document)[_^M_][_$_]
+ , makeTag "Rules" (concatMap toContents [_^M_][_$_]
+ $ getRules document)[_^M_][_$_]
+ ]) () ][_^M_][_$_]
+ parseContents = do[_^M_][_$_]
+ { inElement "Document" $ do[_^M_][_$_]
+ { net <- inElement "Network" $ parseContents[_^M_][_$_]
+ ; pal <- inElement "Palette" $ parseContents[_^M_][_$_]
+ ; rus <- inElement "Rules" $ many1 parseContents[_^M_][_$_]
+ ; return ( setRules rus[_^M_][_$_]
+ . setPalette pal[_^M_][_$_]
+ . setNetwork net[_^M_][_$_]
+ $ Doc.empty undefined undefined undefined)[_^M_][_$_]
+ }[_^M_][_$_]
+ }[_^M_][_$_]
+[_^M_][_$_]
+instance HTypeable a => HTypeable (Palette a) where[_^M_][_$_]
+ toHType p = Defined "Palette" [toHType a] [Constr "Palette" [] []][_^M_][_$_]
+ where (Palette ((_,(_,_,Just a)):_)) = p[_^M_][_$_]
+instance XmlContent a => XmlContent (Palette a) where[_^M_][_$_]
+ toContents (Palette shapes) =[_^M_][_$_]
+ [ mkElemC "Palette" (concatMap toContents shapes) ][_^M_][_$_]
+ parseContents = do[_^M_][_$_]
+ { inElement "Palette" $ fmap Palette (many1 parseContents) }[_^M_][_$_]
+[_^M_][_$_]
+[_^M_][_$_]
+instance HTypeable (INRule g n e) where[_^M_][_$_]
+ toHType _ = Defined "INRule" [] [Constr "INRule" [] []][_^M_][_$_]
+instance (InfoKind n g, InfoKind e g, XmlContent g) =>[_^M_][_$_]
+ XmlContent (INRule g n e) where[_^M_][_$_]
+ toContents rule = [_^M_][_$_]
+ [CElem (Elem "INRule" [][_^M_][_$_]
+ [ escapeString "Name" (getName rule)[_^M_][_$_]
+ , makeTag "LHS" (toContents $ getLHS rule)[_^M_][_$_]
+ , makeTag "RHS" (toContents $ getRHS rule)[_^M_][_$_]
+ , makeTag "Mapping" (concatMap toContents [_^M_][_$_]
+ $ getMapping rule)[_^M_][_$_]
+ ]) () ][_^M_][_$_]
+ parseContents = do[_^M_][_$_]
+ { inElement "INRule" $ do[_^M_][_$_]
+[_^M_][_$_]
+ { nam <- inElement "Name" $ XML.text[_^M_][_$_]
+ ; lhs <- inElement "LHS" $ parseContents[_^M_][_$_]
+ ; rhs <- inElement "RHS" $ parseContents[_^M_][_$_]
+ ; maa <- inElement "Mapping" $ many1 parseContents[_^M_][_$_]
+ ; return ( INRule.construct nam lhs rhs maa)[_^M_][_$_]
+ }[_^M_][_$_]
+ }[_^M_][_$_]
+[_^M_][_$_]
hunk ./src/GUIEvents.hs 7
+import Ports
hunk ./src/GUIEvents.hs 22
- do{ pDoc <- getDocument state
- ; doc <- PD.getDocument pDoc
- ; ppi <- getScreenPPI
- ; let network = getNetwork doc
+ do{ pDoc <- getDocument state
+ ; canvas <- getActiveCanvas state
+ ; doc <- PD.getDocument pDoc
+ ; ppi <- getScreenPPI
+ ; let network = selectNetwork doc canvas [_$_]
hunk ./src/GUIEvents.hs 28
- ; case clickedNodePort doubleMousePoint doc of
+ ; case clickedNodePort doubleMousePoint doc canvas of
hunk ./src/GUIEvents.hs 33
- Nothing ->
+ Nothing -> -- click in empty area
hunk ./src/GUIEvents.hs 37
- Just edgeNr ->
+ Just edgeNr -> -- click over the edge edgeNr
hunk ./src/GUIEvents.hs 44
- Just (edgeNr,viaNr) ->
+ Just (edgeNr,viaNr) -> -- click over the via viaNr on edge edgeNr
hunk ./src/GUIEvents.hs 47
- MultipleSelection _ ns vs
- | (edgeNr,viaNr) `elem` vs->
- pickupMultiple ns vs doubleMousePoint state
+ MultipleSelection canv _ ns vs
+ | (edgeNr,viaNr) `elem` vs && canv == canvas ->
+ pickupMultiple ns vs doubleMousePoint state
hunk ./src/GUIEvents.hs 55
- Just (nodeNr, mPort) ->
+ Just (nodeNr, mPort) -> -- click over node nodeNr and [_$_]
+ -- if also click on a port of that node mPort will be
+ -- Just port or [_$_]
+ -- Nothing if click over a node but none of its ports
hunk ./src/GUIEvents.hs 61
- MultipleSelection _ ns vs | nodeNr `elem` ns ->
- pickupMultiple ns vs doubleMousePoint state
+ MultipleSelection canv _ ns vs [_$_]
+ | nodeNr `elem` ns && canv == canvas ->
+ pickupMultiple ns vs doubleMousePoint state
hunk ./src/GUIEvents.hs 66
- do{ selectNode nodeNr state
+ do{ selectPort nodeNr mPort state
hunk ./src/GUIEvents.hs 74
- do{ pDoc <- getDocument state
- ; doc <- PD.getDocument pDoc
- ; ppi <- getScreenPPI
- ; let network = getNetwork doc
+ do{ pDoc <- getDocument state
+ ; canvas <- getActiveCanvas state
+ ; doc <- PD.getDocument pDoc
+ ; ppi <- getScreenPPI
+ ; let network = selectNetwork doc canvas [_$_]
hunk ./src/GUIEvents.hs 80
- ; case clickedNodePort doubleMousePoint doc of
+ ; case clickedNodePort doubleMousePoint doc canvas of
hunk ./src/GUIEvents.hs 89
- case (getSelection doc, mP) of
- (NodeSelection i Nothing, Nothing) | i /= j -> logMessage "Only allow connections between ports." -- createEdge i j state
- (NodeSelection i Nothing, Just p') -> logMessage "Repeat it selecting a source port."
- (NodeSelection i (Just p),Nothing) -> logMessage "Select a destination port."
- (NodeSelection i (Just p), Just p') | i /= j -> createEdgePorts i p j p' state
- (_, Nothing) -> selectNode j state
- (_, Just p') -> selectPort j p' state
- }
+ case (getSelection doc, mP, canvas) of
+ (NodeSelection canv i (Just p), Just p', canvas) [_$_]
+ | canv==canvas -> createEdgePorts i p j p' state
+ (NodeSelection (LHS rL) i (Just p), Just p', RHS rR) [_$_]
+ | rL==rR && p `isTheSameAs` p' && isInterfacePort p
+ -> createMapping rL i (Just p) j (Just p') state
+ -- print ("CREATING MAP: ", rL, (i, mPL), (nNrR, mPR))
hunk ./src/GUIEvents.hs 97
+{-
+ (NodeSelection canv i Nothing, Nothing, canvas) | i /= j -- no edges from one node to it self
+ -> if hasPorts then logMessage "Only allow connections between ports." else ?? -- createEdge i j state [_$_]
+ (NodeSelection canv i Nothing, Just p') -> logMessage "Repeat it selecting a source port."
+ (NodeSelection canv i (Just p),Nothing) -> logMessage "Select a destination port."
+ (NodeSelection canv i (Just p), Just p') | i /= j -> createEdgePorts i p j p' state
+-} [_$_]
+ _ -> selectPort j mP state
+ } [_$_]
+
+-- para mudar
hunk ./src/GUIEvents.hs 112
+ ; canvas <- getActiveCanvas state
hunk ./src/GUIEvents.hs 115
- ; let network = getNetwork doc
+ ; let network = selectNetwork doc canvas [_$_]
hunk ./src/GUIEvents.hs 117
- ; case clickedNode doubleMousePoint doc of
+ ; case clickedNode doubleMousePoint doc canvas of
+
hunk ./src/GUIEvents.hs 121
- NodeSelection i _ {-??-}
+ NodeSelection _ i _ {-??-}
hunk ./src/GUIEvents.hs 124
- ViaSelection e v -> selectMultiple Nothing [j] [(e,v)] state
- MultipleSelection _ ns vs
+ ViaSelection _ e v -> selectMultiple Nothing [j] [(e,v)] state
+ MultipleSelection _ _ ns vs
hunk ./src/GUIEvents.hs 133
- NodeSelection i _ {-??-} -> selectMultiple Nothing [i] [(e,v)] state
- ViaSelection e' v'
+ NodeSelection _ i _ {-??-} -> selectMultiple Nothing [i] [(e,v)] state
+ ViaSelection _ e' v'
hunk ./src/GUIEvents.hs 138
- MultipleSelection _ ns vs
+ MultipleSelection _ _ ns vs
hunk ./src/GUIEvents.hs 147
-leftMouseDrag mousePoint canvas state =
+leftMouseDrag mousePoint _ state =
hunk ./src/GUIEvents.hs 151
- do{ pDoc <- getDocument state
- ; doc <- PD.getDocument pDoc
+ do{ pDoc <- getDocument state
+ ; doc <- PD.getDocument pDoc
+ ; canvas <- getActiveCanvas state
hunk ./src/GUIEvents.hs 156
- NodeSelection nodeNr _ ->
- dragNode nodeNr doubleMousePoint canvas state
- ViaSelection edgeNr viaNr ->
- dragVia edgeNr viaNr doubleMousePoint canvas state
- MultipleSelection Nothing ns vs ->
- dragMultiple ns vs doubleMousePoint canvas state
- MultipleSelection _ _ _ ->
+ NodeSelection canv nodeNr _ | canv == canvas ->
+ dragNode nodeNr doubleMousePoint state
+ ViaSelection canv edgeNr viaNr | canv == canvas ->
+ dragVia edgeNr viaNr doubleMousePoint state
+ MultipleSelection canv Nothing ns vs | canv == canvas ->
+ dragMultiple ns vs doubleMousePoint state
+ MultipleSelection canv _ _ _ | canv == canvas ->
hunk ./src/GUIEvents.hs 164
- _ -> return ()
+ _ -> do selectNothing state
+ -- setDragging Nothing state
hunk ./src/GUIEvents.hs 174
- do{ pDoc <- getDocument state
- ; doc <- PD.getDocument pDoc
+ do{ pDoc <- getDocument state
+ ; doc <- PD.getDocument pDoc
+ ; canvas <- getActiveCanvas state
hunk ./src/GUIEvents.hs 179
- NodeSelection nodeNr _ {-??-} ->
+ NodeSelection canv nodeNr _ | canv == canvas ->
hunk ./src/GUIEvents.hs 181
- ViaSelection edgeNr viaNr ->
+ ViaSelection canv edgeNr viaNr | canv == canvas ->
hunk ./src/GUIEvents.hs 183
- MultipleSelection Nothing ns vs ->
+ MultipleSelection canv Nothing ns vs | canv == canvas ->
hunk ./src/GUIEvents.hs 185
- MultipleSelection _ _ _ ->
+ MultipleSelection canv _ _ _ | canv == canvas->
hunk ./src/GUIEvents.hs 187
- _ -> return ()
+ _ -> do selectNothing state
+ -- setDragging Nothing state
+ -- return ()
addfile ./src/INRule.hs
hunk ./src/INRule.hs 1
+{-| Module : INRule[_^M_][_$_]
+ Maitainer : jmvilaca@di.uminho.pt[_^M_][_$_]
+[_^M_][_$_]
+ [_^M_][_$_]
+-}[_^M_][_$_]
+[_^M_][_$_]
+module INRule [_^M_][_$_]
+ ( INRule[_^M_][_$_]
+ , initial[_^M_][_$_]
+[_^M_][_$_]
+ , getName, setName[_^M_][_$_]
+ , getLHS, setLHS[_^M_][_$_]
+ , getRHS, setRHS[_^M_][_$_]
+ , getMapping, setMapping[_^M_][_$_]
+ , construct[_^M_][_$_]
+ [_^M_][_$_]
+ , updateLHS[_^M_][_$_]
+ , updateRHS[_^M_][_$_]
+ , updateMapping[_^M_][_$_]
+ [_^M_][_$_]
+ , addMapping[_^M_][_$_]
+ ) where[_^M_][_$_]
+[_^M_][_$_]
+import Network hiding (getName, setName)[_^M_][_$_]
+import Ports[_^M_][_$_]
+import InfoKind[_^M_][_$_]
+[_^M_][_$_]
+import Data.List[_^M_][_$_]
+[_^M_][_$_]
+[_^M_][_$_]
+data INRule g n e = INRule [_^M_][_$_]
+ { ruleName :: String -- ^ the name of the rule[_^M_][_$_]
+ , ruleLHS :: Network g n e -- ^ the rule LHS network [_^M_][_$_]
+ , ruleRHS :: Network g n e -- ^ the rule RHS network [_^M_][_$_]
+ , ruleMaps :: Mapping -- ^ mappings between the LHS and RHS[_^M_][_$_]
+ } deriving (Show)[_^M_][_$_]
+[_^M_][_$_]
+-- | @((n_i, p_a), (n_j, p_b))@ means that port p_a in node n_i in the LHS of the rule corresponds to port p_b in node n_j in the RHS[_^M_][_$_]
+type MappingElement = ((NodeNr, Maybe Port), (NodeNr, Maybe Port))[_^M_][_$_]
+type Mapping = [MappingElement] [_^M_][_$_]
+[_^M_][_$_]
+[_^M_][_$_]
+initial :: (InfoKind e g, InfoKind n g) => g -> n -> e -> INRule g n e[_^M_][_$_]
+initial g n e =[_^M_][_$_]
+ INRule { ruleName = "Rule 1"[_^M_][_$_]
+ , ruleLHS = Network.empty g n e [_^M_][_$_]
+ , ruleRHS = Network.empty g n e[_^M_][_$_]
+ , ruleMaps = [][_^M_][_$_]
+ }[_^M_][_$_]
+[_^M_][_$_]
+-- Set's e Get's[_^M_][_$_]
+getName :: INRule g n e -> String[_^M_][_$_]
+getName = ruleName[_^M_][_$_]
+[_^M_][_$_]
+getLHS :: INRule g n e -> Network g n e[_^M_][_$_]
+getLHS = ruleLHS [_^M_][_$_]
+[_^M_][_$_]
+getRHS :: INRule g n e -> Network g n e[_^M_][_$_]
+getRHS = ruleRHS[_^M_][_$_]
+[_^M_][_$_]
+getMapping :: INRule g n e -> Mapping[_^M_][_$_]
+getMapping = ruleMaps[_^M_][_$_]
+[_^M_][_$_]
+setName :: String -> INRule g n e -> INRule g n e[_^M_][_$_]
+setName newRuleName rule = rule { ruleName = newRuleName}[_^M_][_$_]
+[_^M_][_$_]
+setLHS :: Network g n e -> INRule g n e -> INRule g n e[_^M_][_$_]
+setLHS newRuleLHS rule = rule { ruleLHS = newRuleLHS}[_^M_][_$_]
+[_^M_][_$_]
+setRHS :: Network g n e -> INRule g n e -> INRule g n e[_^M_][_$_]
+setRHS newRuleRHS rule = rule { ruleRHS = newRuleRHS}[_^M_][_$_]
+[_^M_][_$_]
+setMapping :: Mapping -> INRule g n e -> INRule g n e[_^M_][_$_]
+setMapping newRuleMaps rule = rule { ruleMaps = newRuleMaps}[_^M_][_$_]
+[_^M_][_$_]
+construct :: String -- ^ rule name[_^M_][_$_]
+ -> Network g n e -- ^ lhs[_^M_][_$_]
+ -> Network g n e -- ^ rhs[_^M_][_$_]
+ -> Mapping -- ^ correspondences between [_^M_][_$_]
+ -- lhs and rhs interface[_^M_][_$_]
+ -> INRule g n e[_^M_][_$_]
+construct theRuleName lhs rhs mapping =[_^M_][_$_]
+ INRule { ruleName = theRuleName[_^M_][_$_]
+ , ruleLHS = lhs [_^M_][_$_]
+ , ruleRHS = rhs[_^M_][_$_]
+ , ruleMaps = mapping[_^M_][_$_]
+ }[_^M_][_$_]
+[_^M_][_$_]
+-- update LHS and RHS networks and mapping[_^M_][_$_]
+[_^M_][_$_]
+updateLHS :: (Network g n e -> Network g n e)[_^M_][_$_]
+ -> INRule g n e -> INRule g n e[_^M_][_$_]
+updateLHS networkFun rule = rule { ruleLHS = networkFun $ ruleLHS rule }[_^M_][_$_]
+[_^M_][_$_]
+updateRHS :: (Network g n e -> Network g n e)[_^M_][_$_]
+ -> INRule g n e -> INRule g n e[_^M_][_$_]
+updateRHS networkFun rule = rule { ruleRHS = networkFun $ ruleRHS rule }[_^M_][_$_]
+[_^M_][_$_]
+updateMapping :: (Mapping -> Mapping)[_^M_][_$_]
+ -> INRule g n e -> INRule g n e[_^M_][_$_]
+updateMapping mapFun rule = rule { ruleMaps = mapFun $ ruleMaps rule }[_^M_][_$_]
+[_^M_][_$_]
+-- operations on Mappings[_^M_][_$_]
+addMapping :: MappingElement -> Mapping -> Mapping[_^M_][_$_]
+addMapping = insert [_^M_][_$_]
addfile ./src/INRules.hs
hunk ./src/INRules.hs 1
+{-| Module : INRules[_^M_][_$_]
+ Maitainer : jmvilaca@di.uminho.pt[_^M_][_$_]
+[_^M_][_$_]
+ [_^M_][_$_]
+-}[_^M_][_$_]
+[_^M_][_$_]
+module INRules[_^M_][_$_]
+ ( INRules[_^M_][_$_]
+ , empty[_^M_][_$_]
+[_^M_][_$_]
+ , updateRule[_^M_][_$_]
+ , rulesNames[_^M_][_$_]
+ , findRule[_^M_][_$_]
+ , fromRule[_^M_][_$_]
+ , addNewRule[_^M_][_$_]
+ , removeRule[_^M_][_$_]
+ ) where[_^M_][_$_]
+[_^M_][_$_]
+import INRule[_^M_][_$_]
+import InfoKind[_^M_][_$_]
+[_^M_][_$_]
+import Data.List[_^M_][_$_]
+[_^M_][_$_]
+type INRules g n e = [INRule g n e] [_^M_][_$_]
+[_^M_][_$_]
+-- | Empty set of rules.[_^M_][_$_]
+empty :: (InfoKind e g, InfoKind n g) => g -> n -> e -> INRules g n e[_^M_][_$_]
+empty g n e = [][_^M_][_$_]
+[_^M_][_$_]
+[_^M_][_$_]
+updateRule :: String -> (INRule g n e -> INRule g n e) [_^M_][_$_]
+ -> INRules g n e -> INRules g n e[_^M_][_$_]
+updateRule ruleName ruleFunc rules = map f rules [_^M_][_$_]
+ where f rule | ruleName == getName rule = ruleFunc rule[_^M_][_$_]
+ | otherwise = rule[_^M_][_$_]
+[_^M_][_$_]
+rulesNames :: INRules g n e -> [String][_^M_][_$_]
+rulesNames = map getName [_^M_][_$_]
+[_^M_][_$_]
+sameName :: String -> INRule g n e -> Bool[_^M_][_$_]
+sameName ruleName rule = (getName rule) == ruleName[_^M_][_$_]
+[_^M_][_$_]
+findRule :: String -> INRules g n e -> Maybe (INRule g n e)[_^M_][_$_]
+findRule ruleName rules = find (sameName ruleName) rules[_^M_][_$_]
+[_^M_][_$_]
+fromRule :: (INRule g n e -> x) -> String -> INRules g n e -> Maybe x[_^M_][_$_]
+fromRule func ruleName rules = [_^M_][_$_]
+ case findRule ruleName rules of[_^M_][_$_]
+ Just rule -> Just $ func rule[_^M_][_$_]
+ Nothing -> Nothing [_^M_][_$_]
+[_^M_][_$_]
+addNewRule :: (InfoKind e g, InfoKind n g) => [_^M_][_$_]
+ String -> g -> n -> e -> INRules g n e -> INRules g n e [_^M_][_$_]
+addNewRule ruleName g n e rules = [_^M_][_$_]
+ let newRule = setName ruleName $ initial g n e[_^M_][_$_]
+ in rules ++ [newRule] [_^M_][_$_]
+[_^M_][_$_]
+removeRule :: (InfoKind e g, InfoKind n g) => [_^M_][_$_]
+ String -> INRules g n e -> INRules g n e[_^M_][_$_]
+removeRule ruleName rules = filter (not . sameName ruleName) rules[_^M_][_$_]
+[_^M_][_$_]
hunk ./src/Math.hs 29
- deriving (Show, Eq, Read)
+ deriving (Show, Eq, Read, Ord)
hunk ./src/Network.hs 17
- , getPalette, setPalette
hunk ./src/Network.hs 57
-import Palette hiding (delete)
hunk ./src/Network.hs 58
+import Palette (Palette, shapes)
hunk ./src/Network.hs 67
- , networkPalette :: Palette n -- ^ the current 'Palette'
hunk ./src/Network.hs 98
- , networkPalette = Palette.empty
hunk ./src/Network.hs 113
- , networkPalette = fmap (const blank) $ networkPalette network
hunk ./src/Network.hs 339
-getPalette :: Network g n e -> Palette n
-getPalette network = networkPalette network
-
hunk ./src/Network.hs 405
+ -> Palette n -- ^ the palette
hunk ./src/Network.hs 409
-addNode shape network =
+addNode shape palette network =
hunk ./src/Network.hs 414
- (maybe Nothing snd3 $ Data.List.lookup shape palette)
+ (maybe Nothing snd3 $ Data.List.lookup shape palette')
hunk ./src/Network.hs 419
- palette = shapes $ getPalette network
- snd3 (_,p,_) = p
+ palette' = shapes palette
hunk ./src/Network.hs 422
-addNodes :: InfoKind n g => String -> Int -> Network g n e -> ([NodeNr], Network g n e)
-addNodes _ 0 network = ([], network)
-addNodes shapeName n network1 =
- let (nodeNr, network2) = addNode shapeName network1
- (nodeNrs, network3) = addNodes shapeName (n-1) network2
+addNodes :: InfoKind n g => String -> Palette n -> Int -> Network g n e -> ([NodeNr], Network g n e)
+addNodes _ _ 0 network = ([], network)
+addNodes shapeName palette n network1 =
+ let (nodeNr, network2) = addNode shapeName palette network1
+ (nodeNrs, network3) = addNodes shapeName palette (n-1) network2
hunk ./src/Network.hs 504
-
-setPalette :: Palette n -> Network g n e -> Network g n e
-setPalette palette network = network { networkPalette = palette }
hunk ./src/NetworkControl.hs 7
+ , createMapping
hunk ./src/NetworkControl.hs 19
- [_$_]
+ [_$_]
+{- | pickupX functions with X belonging to {Node, Edge, Via, Area, Multiple} do
+ 1 - setDragging on
+ 2 - selects X
+-}
+
+ [_$_]
hunk ./src/NetworkControl.hs 31
+import INRule
+import INRules
hunk ./src/NetworkControl.hs 46
+
+
hunk ./src/NetworkControl.hs 50
- do{ pDoc <- getDocument state
- ; doc <- PD.getDocument pDoc
+ do{ pDoc <- getDocument state
+ ; doc <- PD.getDocument pDoc
+ ; canvas <- getActiveCanvas state
hunk ./src/NetworkControl.hs 54
- NodeSelection nodeNr _ -> [_$_]
+ NodeSelection canv nodeNr _ | canv == canvas -> [_$_]
hunk ./src/NetworkControl.hs 56
- (updateNetwork [_$_]
+ (updateSelNetwork [_$_]
hunk ./src/NetworkControl.hs 58
- (setNameAbove above))) pDoc
+ (setNameAbove above)) canvas) pDoc
hunk ./src/NetworkControl.hs 66
- do{ pDoc <- getDocument state
- ; doc <- PD.getDocument pDoc
+ do{ pDoc <- getDocument state
+ ; doc <- PD.getDocument pDoc
+ ; canvas <- getActiveCanvas state
hunk ./src/NetworkControl.hs 70
- NodeSelection nodeNr _ -> [_$_]
+ NodeSelection canv nodeNr _ | canv == canvas -> [_$_]
hunk ./src/NetworkControl.hs 72
- (updateNetwork [_$_]
+ (updateSelNetwork [_$_]
hunk ./src/NetworkControl.hs 74
- (setInfo info . setShape (Left shapename)))) pDoc
+ (setInfo info . setShape (Left shapename))) canvas) pDoc
hunk ./src/NetworkControl.hs 82
- do{ pDoc <- getDocument state
- ; doc <- PD.getDocument pDoc
+ do{ pDoc <- getDocument state
+ ; doc <- PD.getDocument pDoc
+ ; canvas <- getActiveCanvas state
hunk ./src/NetworkControl.hs 86
- NodeSelection nodeNr _ -> [_$_]
+ NodeSelection canv nodeNr _ | canv == canvas -> [_$_]
hunk ./src/NetworkControl.hs 88
- ( setSelection NoSelection [_$_]
- . updateNetwork (removeNode nodeNr)
+ ( setSelection NoSelection
+ . removeMappingElemWithNode canv nodeNr [_$_]
+ . updateSelNetwork (removeNode nodeNr) canvas
hunk ./src/NetworkControl.hs 94
- EdgeSelection edgeNr -> [_$_]
+ EdgeSelection canv edgeNr | canv == canvas -> [_$_]
hunk ./src/NetworkControl.hs 97
- . updateNetwork (removeEdge edgeNr)
+ . updateSelNetwork (removeEdge edgeNr) canvas
hunk ./src/NetworkControl.hs 101
- ViaSelection edgeNr viaNr ->
+ ViaSelection canv edgeNr viaNr | canv == canvas ->
hunk ./src/NetworkControl.hs 104
- . updateNetwork (removeVia edgeNr viaNr)
+ . updateSelNetwork (removeVia edgeNr viaNr) canvas
hunk ./src/NetworkControl.hs 113
- do{ pDoc <- getDocument state
+ do{ pDoc <- getDocument state
hunk ./src/NetworkControl.hs 115
- ; doc1 <- PD.getDocument pDoc [_$_]
- ; let (nodeNr, doc2) = updateNetworkEx (addNode shapeName) doc1
- doc3 = updateNetwork (updateNode nodeNr ( setPosition mousePoint) ) doc2
- doc4 = setSelection (NodeSelection nodeNr Nothing) doc3
- ; PD.setDocument "add node" doc4 pDoc
+ ; canvas <- getActiveCanvas state
+ ; doc1 <- PD.getDocument pDoc [_$_]
+
+ ; let palette = getPalette doc1
+ (nodeNr, doc2) = updateSelNetworkEx [_$_]
+ (setNewPosition . addNode shapeName palette) [_$_]
+ canvas doc1
+ doc3 = setSelection (NodeSelection canvas nodeNr Nothing) doc2
+ ; PD.setDocument ("add node on " ++ show' canvas) doc3 pDoc [_$_]
hunk ./src/NetworkControl.hs 126
+ where setNewPosition (nodeNr, newNet) = [_$_]
+ (nodeNr, updateNode nodeNr ( setPosition mousePoint) newNet )
hunk ./src/NetworkControl.hs 138
- do{ pDoc <- getDocument state
- ; PD.superficialUpdateDocument (setSelection (EdgeSelection edgeNr)) pDoc
+ do{ pDoc <- getDocument state
+ ; canvas <- getActiveCanvas state
+ ; PD.superficialUpdateDocument (setSelection (EdgeSelection canvas edgeNr)) pDoc
hunk ./src/NetworkControl.hs 146
- do{ pDoc <- getDocument state
- ; PD.updateDocument "add edge"
- ( setSelection (NodeSelection fromNodeNr Nothing)
- . updateNetwork (addEdge fromNodeNr Nothing toNodeNr Nothing)
+ do{ pDoc <- getDocument state
+ ; canvas <- getActiveCanvas state
+ ; PD.updateDocument "add edge" [_$_]
+ ( setSelection (NodeSelection canvas fromNodeNr Nothing)
+ . updateSelNetwork (addEdge fromNodeNr Nothing toNodeNr Nothing) canvas
hunk ./src/NetworkControl.hs 157
- do{ pDoc <- getDocument state
+ do{ pDoc <- getDocument state
+ ; canvas <- getActiveCanvas state
hunk ./src/NetworkControl.hs 160
- ( setSelection (NodeSelection fromNodeNr $ Just fromPort)
- . updateNetwork (addEdge fromNodeNr (Just fromPort) toNodeNr (Just toPort))
- ) pDoc
+ ( setSelection (NodeSelection canvas fromNodeNr $ Just fromPort)
+ . updateSelNetwork (addEdge fromNodeNr (Just fromPort) toNodeNr (Just toPort))
+ canvas ) pDoc
hunk ./src/NetworkControl.hs 166
+createMapping :: RuleName -- ^ rule to add the mapping to
+ -> NodeNr -- ^ LHS node number
+ -> Maybe Port -- ^ LHS possible port
+ -> NodeNr -- ^ RHS node number
+ -> Maybe Port -- ^ RHS possible port
+ -> State g n e -> IO ()
+createMapping rule nNrL mPL nNrR mPR state =
+ do{ pDoc <- getDocument state
+ ; PD.updateDocument ("add mapping to rule " ++ rule)
+ (updateRules [_$_]
+ $ updateRule rule [_$_]
+ $ updateMapping [_$_]
+ $ addMapping ((nNrL, mPL),(nNrR, mPR)) [_$_]
+ ) pDoc
+ ; repaintAll state
+ }
+
hunk ./src/NetworkControl.hs 185
- do{ pDoc <- getDocument state
- ; doc <- PD.getDocument pDoc
- ; let network = getNetwork doc
+ do{ pDoc <- getDocument state
+ ; doc <- PD.getDocument pDoc
+ ; canvas <- getActiveCanvas state
+ ; let network = selectNetwork doc canvas
hunk ./src/NetworkControl.hs 190
- EdgeSelection edgeNr ->
+ EdgeSelection canv edgeNr | canv == canvas ->
hunk ./src/NetworkControl.hs 194
- ( setSelection (ViaSelection edgeNr viaNr)
- . updateNetwork (newViaEdge edgeNr viaNr mousepoint)
+ ( setSelection (ViaSelection canvas edgeNr viaNr)
+ . updateSelNetwork (newViaEdge edgeNr viaNr mousepoint) canvas
hunk ./src/NetworkControl.hs 205
- do{ pDoc <- getDocument state
- ; PD.superficialUpdateDocument (setSelection (ViaSelection edgeNr viaNr))
+ do{ pDoc <- getDocument state
+ ; canvas <- getActiveCanvas state
+ ; PD.superficialUpdateDocument (setSelection (ViaSelection canvas edgeNr viaNr))
hunk ./src/NetworkControl.hs 214
- do{ pDoc <- getDocument state
- ; doc <- PD.getDocument pDoc
- ; let network = getNetwork doc
+ do{ pDoc <- getDocument state
+ ; doc <- PD.getDocument pDoc
+ ; canvas <- getActiveCanvas state
+ ; let network = selectNetwork doc canvas
hunk ./src/NetworkControl.hs 224
-selectNode nodeNr state = [_$_]
- do{ pDoc <- getDocument state
- ; PD.superficialUpdateDocument (setSelection (NodeSelection nodeNr Nothing)) pDoc
- ; repaintAll state
- }
+selectNode nodeNr state = selectPort nodeNr Nothing state
hunk ./src/NetworkControl.hs 226
-selectPort :: Int -> Port -> State g n e -> IO ()
-selectPort nodeNr port state = [_$_]
- do{ pDoc <- getDocument state
- ; PD.superficialUpdateDocument (setSelection $ NodeSelection nodeNr $ Just port) pDoc
+selectPort :: Int -> Maybe Port -> State g n e -> IO ()
+selectPort nodeNr mPort state = [_$_]
+ do{ pDoc <- getDocument state
+ ; canvas <- getActiveCanvas state
+ ; PD.superficialUpdateDocument (setSelection $ NodeSelection canvas nodeNr mPort) pDoc
hunk ./src/NetworkControl.hs 236
- do{ pDoc <- getDocument state
- ; doc <- PD.getDocument pDoc
- ; let network = getNetwork doc
+ do{ pDoc <- getDocument state
+ ; doc <- PD.getDocument pDoc
+ ; canvas <- getActiveCanvas state
+ ; let network = selectNetwork doc canvas
hunk ./src/NetworkControl.hs 242
- ; case mPort of [_$_]
- Nothing -> selectNode nodeNr state
- Just p -> selectPort nodeNr p state
+ ; selectPort nodeNr mPort state
hunk ./src/NetworkControl.hs 245
-dragNode :: Int -> DoublePoint -> ScrolledWindow () -> State g n e -> IO ()
-dragNode nodeNr mousePoint canvas state = [_$_]
- do{ pDoc <- getDocument state
- ; doc <- PD.getDocument pDoc
+dragNode :: Int -> DoublePoint -> State g n e -> IO ()
+dragNode nodeNr mousePoint state = [_$_]
+ do{ pDoc <- getDocument state
+ ; doc <- PD.getDocument pDoc
+ ; canvas <- getActiveCanvas state
hunk ./src/NetworkControl.hs 252
- oldPosition = getNodePosition (getNetwork doc) nodeNr
+ oldPosition = getNodePosition (selectNetwork doc canvas) nodeNr
hunk ./src/NetworkControl.hs 258
- (updateNetwork (updateNode nodeNr [_$_]
- (setPosition newPosition))) [_$_]
+ (updateSelNetwork (updateNode nodeNr [_$_]
+ (setPosition newPosition)) canvas ) [_$_]
hunk ./src/NetworkControl.hs 261
- ; Graphics.UI.WX.repaint canvas
+ ; repaintAll state
hunk ./src/NetworkControl.hs 271
- ; pDoc <- getDocument state
+ ; pDoc <- getDocument state
+ ; canvas <- getActiveCanvas state
hunk ./src/NetworkControl.hs 274
- (updateNetwork (updateNode nodeNr [_$_]
- (setPosition newPosition))) pDoc
+ (updateSelNetwork (updateNode nodeNr [_$_]
+ (setPosition newPosition)) canvas) pDoc
hunk ./src/NetworkControl.hs 277
- ; canvas <- getCanvas state
- ; Graphics.UI.WX.repaint canvas
+ ; repaintAll state
hunk ./src/NetworkControl.hs 281
-dragVia :: Int -> Int -> DoublePoint -> ScrolledWindow () -> State g n e -> IO ()
-dragVia edgeNr viaNr mousePoint canvas state = [_$_]
- do{ pDoc <- getDocument state
- ; doc <- PD.getDocument pDoc
+dragVia :: Int -> Int -> DoublePoint -> State g n e -> IO ()
+dragVia edgeNr viaNr mousePoint state = [_$_]
+ do{ pDoc <- getDocument state
+ ; doc <- PD.getDocument pDoc
+ ; canvas <- getActiveCanvas state
hunk ./src/NetworkControl.hs 288
- oldPosition = (getEdgeVia (getEdge edgeNr (getNetwork doc)))!!viaNr
+ oldPosition = (getEdgeVia (getEdge edgeNr (selectNetwork doc canvas)))!!viaNr
hunk ./src/NetworkControl.hs 294
- (updateNetwork (updateVia edgeNr viaNr newPosition))
+ (updateSelNetwork (updateVia edgeNr viaNr newPosition) canvas)
hunk ./src/NetworkControl.hs 296
- ; Graphics.UI.WX.repaint canvas
+ ; repaintAll state
hunk ./src/NetworkControl.hs 306
- ; pDoc <- getDocument state
+ ; pDoc <- getDocument state
+ ; canvas <- getActiveCanvas state
hunk ./src/NetworkControl.hs 309
- (updateNetwork (updateVia edgeNr viaNr newPosition))
+ (updateSelNetwork (updateVia edgeNr viaNr newPosition) canvas)
hunk ./src/NetworkControl.hs 312
- ; canvas <- getCanvas state
- ; Graphics.UI.WX.repaint canvas
+ ; repaintAll state
hunk ./src/NetworkControl.hs 319
- do{ pDoc <- getDocument state
+ do{ pDoc <- getDocument state
+ ; canvas <- getActiveCanvas state
hunk ./src/NetworkControl.hs 322
- (setSelection (MultipleSelection area nodeNrs viaNrs))
+ (setSelection (MultipleSelection canvas area nodeNrs viaNrs))
hunk ./src/NetworkControl.hs 333
-dragMultiple :: [Int] -> [(Int,Int)] -> DoublePoint -> ScrolledWindow ()
- -> State g n e -> IO ()
-dragMultiple nodeNrs viaNrs mousePoint canvas state = [_$_]
- do{ pDoc <- getDocument state
+dragMultiple :: [Int] -> [(Int,Int)] -> DoublePoint -> State g n e -> IO ()
+dragMultiple nodeNrs viaNrs mousePoint state = [_$_]
+ do{ pDoc <- getDocument state
+ ; canvas <- getActiveCanvas state
hunk ./src/NetworkControl.hs 345
- (updateNetwork (updateMultiple nodeNrs viaNrs offset))
+ (updateSelNetwork (updateMultiple nodeNrs viaNrs offset) canvas)
hunk ./src/NetworkControl.hs 347
- ; Graphics.UI.WX.repaint canvas
+ ; repaintAll state
hunk ./src/NetworkControl.hs 368
- do{ pDoc <- getDocument state
+ do{ pDoc <- getDocument state
+ ; canvas <- getActiveCanvas state
hunk ./src/NetworkControl.hs 371
- (updateNetwork
+ (updateSelNetwork
hunk ./src/NetworkControl.hs 373
- (mousePoint`subtractDoublePoint`origin)))
+ (mousePoint`subtractDoublePoint`origin)) canvas)
hunk ./src/NetworkControl.hs 376
- ; canvas <- getCanvas state
- ; Graphics.UI.WX.repaint canvas
+ ; repaintAll state
hunk ./src/NetworkControl.hs 390
- do{ pDoc <- getDocument state
- ; doc <- PD.getDocument pDoc
+ do{ pDoc <- getDocument state
+ ; doc <- PD.getDocument pDoc
+ ; canvas <- getActiveCanvas state
hunk ./src/NetworkControl.hs 394
- ; let (ns,vs) = itemsEnclosedWithin mousePoint origin (getNetwork doc)
+ ; let (ns,vs) = itemsEnclosedWithin mousePoint origin (selectNetwork doc canvas)
hunk ./src/NetworkControl.hs 413
- ; pDoc <- getDocument state
- ; doc <- PD.getDocument pDoc
+ ; pDoc <- getDocument state
+ ; doc <- PD.getDocument pDoc
+ ; canvas <- getActiveCanvas state
hunk ./src/NetworkControl.hs 417
- MultipleSelection _ [] [] ->
+ MultipleSelection _ _ [] [] ->
hunk ./src/NetworkControl.hs 419
- MultipleSelection _ ns vs ->
+ MultipleSelection canv _ ns vs | canvas == canv ->
hunk ./src/NetworkControl.hs 421
- (setSelection (MultipleSelection Nothing ns vs)) pDoc
+ (setSelection (MultipleSelection canvas Nothing ns vs)) pDoc
+ | otherwise -> [_$_]
+ PD.superficialUpdateDocument (setSelection NoSelection) pDoc
hunk ./src/NetworkControl.hs 432
- do{ pDoc <- getDocument state
- ; doc <- PD.getDocument pDoc
- ; let network = getNetwork doc
+ do{ pDoc <- getDocument state
+ ; doc <- PD.getDocument pDoc
+ ; canvas <- getActiveCanvas state
+ ; let network = selectNetwork doc canvas
hunk ./src/NetworkControl.hs 437
- NodeSelection nodeNr _ ->
+ NodeSelection canv nodeNr _ | canv == canvas ->
hunk ./src/NetworkControl.hs 443
- (updateNetwork [_$_]
- (updateNode nodeNr (setName newName))) pDoc
+ (updateSelNetwork [_$_]
+ (updateNode nodeNr (Network.setName newName)) canvas) pDoc
hunk ./src/NetworkControl.hs 454
- do{ pDoc <- getDocument state
- ; doc <- PD.getDocument pDoc
- ; let network = getNetwork doc
+ do{ pDoc <- getDocument state
+ ; doc <- PD.getDocument pDoc
+ ; canvas <- getActiveCanvas state
+ ; let network = selectNetwork doc canvas
hunk ./src/NetworkControl.hs 459
- NodeSelection nodeNr _ ->
+ NodeSelection canv nodeNr _ | canv == canvas ->
hunk ./src/NetworkControl.hs 477
- (updateNetwork [_$_]
- (updateNode nodeNr (setInfo x))) pDoc
+ (updateSelNetwork [_$_]
+ (updateNode nodeNr (setInfo x)) canvas) pDoc
hunk ./src/NetworkControl.hs 486
- EdgeSelection edgeNr ->
+ EdgeSelection canv edgeNr | canv == canvas ->
hunk ./src/NetworkControl.hs 504
- (updateNetwork [_$_]
- (updateEdge edgeNr (setEdgeInfo x))) pDoc
+ (updateSelNetwork [_$_]
+ (updateEdge edgeNr (setEdgeInfo x)) canvas) pDoc
hunk ./src/NetworkControl.hs 518
- do{ pDoc <- getDocument state
- ; doc <- PD.getDocument pDoc
- ; let network = getNetwork doc
+ do{ pDoc <- getDocument state
+ ; doc <- PD.getDocument pDoc
+ ; canvas <- getActiveCanvas state
+ ; let network = selectNetwork doc canvas
hunk ./src/NetworkControl.hs 532
- (updateNetwork (setGlobalInfo x)) pDoc
+ (updateSelNetwork (setGlobalInfo x) canvas) pDoc
hunk ./src/NetworkFile.hs 9
-import Palette
hunk ./src/NetworkFile.hs 94
- , makeTag "Palette" (toContents (getPalette network))
hunk ./src/NetworkFile.hs 107
- ; p <- inElement "Palette"$ parseContents
hunk ./src/NetworkFile.hs 111
- . setPalette p
hunk ./src/NetworkFile.hs 297
-
-{- handwritten -}
-instance HTypeable a => HTypeable (Palette a) where
- toHType p = Defined "Palette" [toHType a] [Constr "Palette" [] []]
- where (Palette ((_,(_,_,Just a)):_)) = p
-instance XmlContent a => XmlContent (Palette a) where
- toContents (Palette shapes) =
- [ mkElemC "Palette" (concatMap toContents shapes) ]
- parseContents = do
- { inElement "Palette" $ fmap Palette (many1 parseContents) }
hunk ./src/NetworkUI.hs 12
-import NetworkFile
+import DocumentFile
hunk ./src/NetworkUI.hs 14
+import INRule
+import INRules
hunk ./src/NetworkUI.hs 58
+
+
+noImage = -1 :: Int
hunk ./src/NetworkUI.hs 75
+ ******* tree :: TreeCtrl ()
hunk ./src/NetworkUI.hs 79
+ ****** canvas
hunk ./src/NetworkUI.hs 81
+ ****** canvas
hunk ./src/NetworkUI.hs 102
- ; rulesTreePan <- panel sp2 [layout := label "rules Tree"]
+ ; rulesTreePan <- panel sp2 [] [_$_]
hunk ./src/NetworkUI.hs 104
- ; ruleLHSPan <- panel sp4 [layout := label "LHS of a rule" ] [_$_]
- ; ruleRHSPan <- panel sp4 [layout := label "RHS of a rule" ] [_$_]
+ ; ruleLHSPan <- panel sp4 [] [_$_]
+ ; ruleRHSPan <- panel sp4 []
hunk ./src/NetworkUI.hs 113
- -- Drawing area
+ -- Drawing area for net
hunk ./src/NetworkUI.hs 130
- [ on paint := \dc _ -> safetyNet theFrame $ paintHandler state dc
+ [ on paint := \dc _ -> safetyNet theFrame $ paintHandler state dc Net
hunk ./src/NetworkUI.hs 132
- do mouseEvent p canvas theFrame state
+ do setActiveCanvas Net state
+ mouseEvent p canvas theFrame state
hunk ./src/NetworkUI.hs 136
- do keyboardEvent theFrame state k
+ do setActiveCanvas Net state
+ keyboardEvent theFrame state k
hunk ./src/NetworkUI.hs 139
+ ]
+
+ -- Drawing area for LHS
+ ; let (width, height) = (100, 100) -- getCanvasSize (Network.empty g n e)
+ ; ppi <- getScreenPPI
+ ; canvasLHS <- scrolledWindow ruleLHSPan
+ [ virtualSize := sz (logicalToScreenX ppi width)
+ (logicalToScreenY ppi height)
+ , scrollRate := sz 10 10
+ , bgcolor := wxcolor paneBackgroundColor
+ , fullRepaintOnResize := False
+ ]
+ ; State.setLHSCanvas canvasLHS state
+
+ -- Attach handlers to drawing area
+ ; set canvasLHS
+ [ on paint := \dc _ -> safetyNet theFrame [_$_]
+ $ do rule <- getActiveRule state
+ paintHandler state dc $ LHS rule [_$_]
+ , on mouse := \p -> safetyNet theFrame $
+ do setActiveCanvas (LHS "") state
+ mouseEvent p canvasLHS theFrame state
+ --; focusOn canvasLHS
+ , on keyboard := \k -> safetyNet theFrame $
+ do setActiveCanvas (LHS "") state
+ keyboardEvent theFrame state k
+ --; focusOn canvasLHS
+ ]
+
+ -- Drawing area for RHS
+ ; let (width, height) = (100, 100) -- getCanvasSize (Network.empty g n e)
+ ; ppi <- getScreenPPI
+ ; canvasRHS <- scrolledWindow ruleRHSPan
+ [ virtualSize := sz (logicalToScreenX ppi width)
+ (logicalToScreenY ppi height)
+ , scrollRate := sz 10 10
+ , bgcolor := wxcolor paneBackgroundColor
+ , fullRepaintOnResize := False
+ ]
+ ; State.setRHSCanvas canvasRHS state
+
+ -- Attach handlers to drawing area
+ ; set canvasRHS
+ [ on paint := \dc _ -> safetyNet theFrame [_$_]
+ $ do rule <- getActiveRule state
+ paintHandler state dc $ RHS rule [_$_]
+ , on mouse := \p -> safetyNet theFrame $
+ do setActiveCanvas (RHS "") state
+ mouseEvent p canvasRHS theFrame state
+ --; focusOn canvasLHS
+ , on keyboard := \k -> safetyNet theFrame $
+ do setActiveCanvas (RHS "") state
+ keyboardEvent theFrame state k
+ --; focusOn canvasLHS
hunk ./src/NetworkUI.hs 194
+
hunk ./src/NetworkUI.hs 200
- , on command := safetyNet theFrame $ newItem state
+ , on command := safetyNet theFrame $ newItem state g n e
hunk ./src/NetworkUI.hs 235
- ; paintHandler state dc
+ ; paintHandler state dc Net
hunk ./src/NetworkUI.hs 247
- let printFun _ _ _ dc _ = paintHandler state dc
+ let printFun _ _ _ dc _ = paintHandler state dc Net
hunk ./src/NetworkUI.hs 355
+
+ ; initializeRules state g n e
+ -- Rules Panel
+ ; tree <- treeCtrl rulesTreePan [style :~ (wxTR_EDIT_LABELS .+.)]
+ ; setTree tree state
+ ; top <- treeCtrlAddRoot tree "Rules" noImage noImage objectNull
+ -- ; treeCtrlSetItemClientData tree top (return ()) ""
+ ; addRules2Tree tree top state
+ ; treeCtrlExpand tree top
+ ; set tree [ on treeEvent := onTreeEvent tree state g n e]
hunk ./src/NetworkUI.hs 374
- (widget rulesTreePan) )
+ (container rulesTreePan $ fill $ widget tree) )
hunk ./src/NetworkUI.hs 377
- (widget ruleLHSPan)
- (widget ruleRHSPan) )
+ (container ruleLHSPan $ boxed "LHS" $ fill $ widget canvasLHS)
+ (container ruleRHSPan $ boxed "RHS" $ fill $ widget canvasRHS) )
hunk ./src/NetworkUI.hs 383
- , clientSize := sz 400 440
+ , clientSize := sz 900 600
hunk ./src/NetworkUI.hs 393
+
+-- | Prints a document in a none XMl format
+printy :: (InfoKind n g, InfoKind e g, Show g) => Document.Document g n e -> IO ()
+printy doc = [_$_]
+ do let network = getNetwork doc
+ rules = getRules doc
+ mostraNodos network
+ putStrLn "+++++++++++++++++++++++++++++++"
+ mapM_ f rules
+ where mostraNodos network = print $ map Network.getName $ getNodes network
+ f rule = do putStrLn $ INRule.getName rule
+ putStrLn "lhs"
+ mostraNodos $ getLHS rule
+ putStrLn "rhs"
+ mostraNodos $ getRHS rule
+ print $ INRule.getMapping rule
+ putStrLn "-----------------------------------"
hunk ./src/NetworkUI.hs 412
- State g n e -> DC () -> IO ()
-paintHandler state dc =
- do{ pDoc <- getDocument state
- ; doc <- PD.getDocument pDoc
- ; dp <- getDisplayOptions state
- ; drawCanvas doc dc dp
+ State g n e -> DC () -> ActiveCanvas -> IO ()
+paintHandler state dc canvas =
+ do{ pDoc <- getDocument state
+ ; doc <- PD.getDocument pDoc
+ ; dp <- getDisplayOptions state
+ ; let network = selectNetwork doc canvas
+ selection = getSelection doc
+ palette = getPalette doc
+ selection' = selection `filterSelectionTo` canvas
+ ; mapp <- case canvas of
+ Net -> return []
+ LHS rule -> maybe (fail $ rule ++ " not found.") [_$_]
+ (return . map fst . getMapping) [_$_]
+ . findRule rule $ getRules doc [_$_]
+ RHS rule -> maybe (fail $ rule ++ " not found.") [_$_]
+ (return . map snd . getMapping) [_$_]
+ . findRule rule $ getRules doc [_$_]
+
+ ; drawCanvas network palette selection' mapp dc dp
hunk ./src/NetworkUI.hs 432
+ where filterSelectionTo :: Document.Selection -> ActiveCanvas [_$_]
+ -> Document.Selection
+ filterSelectionTo selection canvas =
+ case selection of
+ NodeSelection canv _ _ | canv == canvas -> selection
+ EdgeSelection canv _ | canv == canvas -> selection
+ ViaSelection canv _ _ | canv == canvas -> selection
+ MultipleSelection canv _ _ _ | canv == canvas -> selection
+ _ -> NoSelection [_$_]
+
+
+chooseNetwork :: State g n e -> IO (Network g n e)
+chooseNetwork state = [_$_]
+ do canvas <- getActiveCanvas state
+ pDoc <- getDocument state
+ doc <- PD.getDocument pDoc
+ case canvas of
+ Net -> return $ getNetwork doc
+ LHS rule -> maybe (fail $ "Invalid rule name: " ++ rule) return [_$_]
+ $ getLHS `fromRule` rule $ getRules doc
+ RHS rule -> maybe (fail $ "Invalid rule name: " ++ rule) return [_$_]
+ $ getRHS `fromRule` rule $ getRules doc
hunk ./src/NetworkUI.hs 494
-newItem :: (InfoKind n g, InfoKind e g) => State g n e -> IO ()
-newItem state =
+newItem :: (InfoKind n g, InfoKind e g) => State g n e -> g -> n -> e -> IO ()
+newItem state g n e =
hunk ./src/NetworkUI.hs 500
+ ; initializeRules state g n e [_$_]
+ ; reAddRules2Tree state
+ ; theFrame <- getNetworkFrame state
+ ; openPaletteFile palette state (Just theFrame)
hunk ./src/NetworkUI.hs 533
- ; let errorOrNetwork = NetworkFile.fromString contents
- ; case errorOrNetwork of {
+ ; let errorOrDocument = DocumentFile.fromString contents
+ ; case errorOrDocument of {
hunk ./src/NetworkUI.hs 536
- Right (network, warnings, oldFormat) ->
- do{ -- "Open" document
- ; let newDoc = setNetwork network (Document.empty undefined undefined undefined)
+ Right (doc, warnings, oldFormat) ->
+ do{ [_$_]
hunk ./src/NetworkUI.hs 540
- newDoc pDoc
+ doc pDoc
hunk ./src/NetworkUI.hs 573
+ ; reAddRules2Tree state [_$_]
hunk ./src/NetworkUI.hs 608
- (updateNetwork (setPalette palette))
+ (setPalette palette)
hunk ./src/NetworkUI.hs 645
- safeWriteFile theFrame fileName (NetworkFile.toString (getNetwork doc))
-
+ safeWriteFile theFrame fileName (DocumentFile.toString doc)
hunk ./src/NetworkUI.hs 658
- ; let palette = getPalette (getNetwork doc)
+ ; let palette = getPalette doc
hunk ./src/NetworkUI.hs 698
+
+
+-- | List the rules on a one level tree. [_$_]
+addRules2Tree :: (InfoKind.InfoKind n g, InfoKind.InfoKind e g) => [_$_]
+ TreeCtrl a -> TreeItem -> State g n e -> IO ()
+addRules2Tree tree item state = [_$_]
+ do pDoc <- getDocument state
+ doc <- PD.getDocument pDoc
+ [_$_]
+ treeCtrlDeleteChildren tree item
+ let rNames = rulesNames $ getRules doc [_$_]
+ mapM_ addItemRule rNames [_$_]
+
+ -- choose the last rule as the active (displayed) one
+ rule <- treeCtrlGetLastChild tree item
+ ruleName <- treeCtrlGetItemText tree rule
+ treeCtrlSelectItem tree rule
+ setActiveRule ruleName state
+ where addItemRule ruleName = [_$_]
+ do{ item <- treeCtrlAppendItem tree item ruleName noImage noImage objectNull [_$_]
+ ; return ()
+ }
+
+-- | Eliminates old rules and add the newer ones.
+reAddRules2Tree :: (InfoKind.InfoKind n g, InfoKind.InfoKind e g) => [_$_]
+ State g n e -> IO ()
+reAddRules2Tree state =
+ do tree <- getTree state
+ root <- treeCtrlGetRootItem tree
+ addRules2Tree tree root state
+ [_$_]
+
+onTreeEvent :: (InfoKind.InfoKind n g, InfoKind.InfoKind e g) => [_$_]
+ TreeCtrl a -> State g n e -> g -> n -> e -> EventTree -> IO ()
+onTreeEvent tree state g n e event = [_$_]
+ case event of [_$_]
+ TreeSelChanged item olditem | treeItemIsOk item
+ -> do wxcBeginBusyCursor
+ ruleName <- treeCtrlGetItemText tree item
+ when (ruleName /= "Rules") $
+ do setActiveRule ruleName state
+ repaintAll state
+ wxcEndBusyCursor
+ propagateEvent
+ TreeBeginLabelEdit item str action [_$_]
+ | str == "Rules" -> action -- prevents the root from be editable
+ TreeEndLabelEdit item new wasCanceled veto | not wasCanceled -> [_$_]
+ do -- change rule name
+ old <- treeCtrlGetItemText tree item
+ [_$_]
+ when (new /= old) $
+ do pDoc <- getDocument state
+ frame <- getNetworkFrame state
+ doc <- PD.getDocument pDoc
+ let rNames = rulesNames $ getRules doc
+ if new `elem` rNames
+ then do veto
+ warningDialog frame "Warning" [_$_]
+ $ "Already exists one rule with name «" ++ new [_$_]
+ ++ "».\n Please choose a different identifier."
+ else do PD.updateDocument "change rule name" [_$_]
+ (updateRules [_$_]
+ $ updateRule old [_$_]
+ $ INRule.setName new) pDoc
+ setActiveRule new state
+ propagateEvent
+ TreeItemRightClick item -> [_$_]
+ do ruleName <- treeCtrlGetItemText tree item
+ contextMenu <- menuPane []
+ theFrame <- getNetworkFrame state [_$_]
+
+ if (ruleName == "Rules") -- means right click on root item
+ then [_$_]
+ do menuItem contextMenu [_$_]
+ [ text := "Add new rule"
+ , on command := safetyNet theFrame $ addNewRuleItem state g n e
+ ] [_$_]
+ else [_$_]
+ do menuItem contextMenu [_$_]
+ [ text := "Rename rule" [_$_]
+ , on command := treeCtrlEditLabel tree item
+ ]
+ menuItem contextMenu [_$_]
+ [ text := "Remove rule"
+ , on command := do safetyNet theFrame [_$_]
+ $ removeRuleItem state ruleName
+ propagateEvent
+ ]
+
+ propagateEvent
+ pointWithinWindow <- windowGetMousePosition theFrame
+ menuPopup contextMenu pointWithinWindow theFrame
+ objectDelete contextMenu
+ _
+ -> propagateEvent
+
+-- | Create a new empty rule with a new name.
+addNewRuleItem :: (InfoKind.InfoKind n g, InfoKind.InfoKind e g) => [_$_]
+ State g n e -> g -> n -> e -> IO ()
+addNewRuleItem state g n e = [_$_]
+ do pDoc <- getDocument state
+ PD.updateDocument "add rule" (updateRules $ addNew 1) pDoc
+ reAddRules2Tree state
+ where -- addNew :: Int -> INRules g n e -> INRules g n e
+ addNew i rules =
+ let newName = "Rule " ++ show i [_$_]
+ in case findRule newName rules of
+ Just _ -> addNew (i+1) rules
+ Nothing -> INRules.addNewRule newName g n e rules [_$_]
+
+removeRuleItem :: (InfoKind n g, InfoKind e g) => [_$_]
+ State g n e -> String -> IO ()
+removeRuleItem state ruleName = [_$_]
+ do frame <- getNetworkFrame state
+ delete <- confirmDialog frame "Rule deletion" msg yesDefault
+ [_$_]
+ when (delete) $ [_$_]
+ do pDoc <- getDocument state
+ PD.updateDocument ("remove rule " ++ ruleName) [_$_]
+ (updateRules $ removeRule ruleName) pDoc
+ reAddRules2Tree state [_$_]
+ where yesDefault = False
+ msg = "Are you sure you want to delete rule «" ++ ruleName ++ "» ?"
+
+-- | If there are none rules it creates a empty one.
+initializeRules :: (InfoKind.InfoKind n g, InfoKind.InfoKind e g) => [_$_]
+ State g n e -> g -> n -> e -> IO ()
+initializeRules state g n e = [_$_]
+ do pDoc <- getDocument state
+ doc <- PD.getDocument pDoc
+ let rNames = rulesNames $ getRules doc
+
+ if (null rNames) [_$_]
+ then
+ do -- adds an inicial rule
+ PD.superficialUpdateDocument [_$_]
+ (updateRules $ addNewRule "Rule 1" g n e) pDoc
+ setActiveRule "Rule 1" state
+ else setActiveRule (head rNames) state [_$_]
hunk ./src/NetworkView.hs 19
-import Graphics.UI.WX as WX hiding (Vector)
-import Graphics.UI.WXCore hiding (Document, screenPPI, Colour)
+import Graphics.UI.WX as WX hiding (Vector, Selection)
+import Graphics.UI.WXCore hiding (Document, screenPPI, Colour, Palette)
hunk ./src/NetworkView.hs 30
+import Data.List
hunk ./src/NetworkView.hs 33
- Document g n e -> DC () -> DisplayOptions -> IO ()
-drawCanvas doc dc opt =
+ Network g n e -> Palette n -> Selection -> [(NodeNr, Maybe Port)] [_$_]
+ -> DC () -> DisplayOptions -> IO ()
+drawCanvas net palette selec p dc opt =
hunk ./src/NetworkView.hs 50
- ; catch (reallyDrawCanvas doc screenPPI dc opt)
+ ; catch (reallyDrawCanvas net palette selec p screenPPI dc opt)
hunk ./src/NetworkView.hs 57
- Document g n e -> Size -> DC () -> DisplayOptions -> IO ()
-reallyDrawCanvas doc ppi dc opt =
+ Network g n e -> Palette n -> Selection -> [(NodeNr, Maybe Port)]
+ -> Size -> DC () -> DisplayOptions -> IO ()
+reallyDrawCanvas network palette theSelection mapp ppi dc opt =
hunk ./src/NetworkView.hs 62
- ; mapM_ (\edge -> drawEdge edge []) (getEdgeAssocs network)
- ; case theSelection of
- EdgeSelection edgeNr -> do
+ ; mapM_ (\edge -> drawEdge edge []) (getEdgeAssocs network)
+ ; case theSelection of
+ EdgeSelection _ edgeNr -> do
hunk ./src/NetworkView.hs 66
- ViaSelection edgeNr viaNr -> do
+ ViaSelection _ edgeNr viaNr -> do
hunk ./src/NetworkView.hs 68
- MultipleSelection _ _ viaNrs -> do
+ MultipleSelection _ _ _ viaNrs -> do
hunk ./src/NetworkView.hs 76
- NodeSelection nodeNr mPort ->
+ NodeSelection _ nodeNr mPort ->
hunk ./src/NetworkView.hs 85
- MultipleSelection _ nodeNrs _ ->
+ MultipleSelection _ _ nodeNrs _ ->
hunk ./src/NetworkView.hs 93
- MultipleSelection (Just (p,q)) _ _ ->
+ MultipleSelection _ (Just (p,q)) _ _ ->
hunk ./src/NetworkView.hs 106
- network = getNetwork doc
- theSelection = getSelection doc
- (Palette palette) = getPalette network
+ palette' = shapes palette [_$_]
hunk ./src/NetworkView.hs 125
+ [_$_]
+ -- draw mapping numbering when needed
+ ; maybe ( return () )
+ showInterfaceMap
+ $ findIndex ( (nodeNr ==) . fst ) mapp
+
hunk ./src/NetworkView.hs 136
- fst3 (a,_,_) = a
hunk ./src/NetworkView.hs 137
- (Prelude.lookup name palette))
+ (Prelude.lookup name palette'))
hunk ./src/NetworkView.hs 141
+ [_$_]
+ showInterfaceMap n = [_$_]
+ drawLabel 0.15 True (show $ succ n) center
+ (justif above) [ textColor := wxcolor kNodeMapColour ]
hunk ./src/NetworkView.hs 238
-clickedNode :: DoublePoint -> Document g n e -> Maybe Int
-clickedNode clickedPoint doc =
- let network = getNetwork doc
+clickedNode :: DoublePoint -> Document g n e -> ActiveCanvas -> Maybe Int
+clickedNode clickedPoint doc canvas =
+ let network = selectNetwork doc canvas [_$_]
hunk ./src/NetworkView.hs 242
- NodeSelection nodeNr _ {-??-} -> [(nodeNr, getNode nodeNr network)]
+ NodeSelection canv nodeNr _ [_$_]
+ | canv == canvas -> [(nodeNr, getNode nodeNr network)]
+ | otherwise -> []
hunk ./src/NetworkView.hs 252
--- mudar esta função para fazer o que deve
-
-clickedNodePort :: DoublePoint -> Document g n e -> Maybe (Int, Maybe Port)
-clickedNodePort clickedPoint doc =
- let network = getNetwork doc
+clickedNodePort :: DoublePoint -> Document g n e -> ActiveCanvas
+ -> Maybe (Int, Maybe Port)
+clickedNodePort clickedPoint doc canvas =
+ let network = selectNetwork doc canvas [_$_]
hunk ./src/NetworkView.hs 257
- NodeSelection nodeNr _ {-??-} -> [(nodeNr, getNode nodeNr network)]
+ NodeSelection canv nodeNr _ [_$_]
+ | canv == canvas -> [(nodeNr, getNode nodeNr network)]
+ | otherwise -> []
hunk ./src/NetworkView.hs 268
- [] -> Just (i, Nothing) -- if the mouse is over a node with nodes but not over any of its ports the node is selected
+ [] -> Just (i, Nothing) -- if the mouse is over a node [_$_]
+ -- with ports but not over any
+ -- of its ports the node is selected
hunk ./src/Ports.hs 22
-{-[_^M_][_$_]
-type Ports = ([Port] -- ^ list of input ports[_^M_][_$_]
- ,[Port]) -- ^ list of output ports[_^M_][_$_]
--}[_^M_][_$_]
+-- | Equality on ports. Right now it is exactly the same as @(==)@.[_^M_][_$_]
+isTheSameAs :: Port -> Port -> Bool[_^M_][_$_]
+isTheSameAs = (==)[_^M_][_$_]
+[_^M_][_$_]
+isInterfacePort :: Port -> Bool[_^M_][_$_]
+isInterfacePort = (== "interface") . fst[_^M_][_$_]
hunk ./src/SafetyNet.hs 22
- ++ "Please save the network under a different name and quit " ++ toolName ++ "."
+ ++ "Please save the document under a different name and quit " ++ toolName ++ "."
hunk ./src/State.hs 9
+ , getLHSCanvas, setLHSCanvas
+ , getRHSCanvas, setRHSCanvas
hunk ./src/State.hs 17
+ , getActiveCanvas, setActiveCanvas
+ , getActiveRule, setActiveRule
+ , getTree, setTree
hunk ./src/State.hs 30
+ [_$_]
+
hunk ./src/State.hs 39
+ , stLHSCanvas :: ScrolledWindow ()
+ , stRHSCanvas :: ScrolledWindow ()
hunk ./src/State.hs 44
- , stShape :: String -- ^the name of the shape in the palette
+ , stShape :: String -- ^ the name of the shape in the palette
+ , stActiveCanvas :: ActiveCanvas -- ^ which canvas is active
+ , stActiveRule :: RuleName -- ^ a interaction rule's name [_$_]
+ , stTree :: TreeCtrl () -- ^ the treeCtrl that lists the rules
hunk ./src/State.hs 64
+ , stLHSCanvas = error "State.empty: canvasLHS has not been set"
+ , stRHSCanvas = error "State.empty: canvasRHS has not been set"
hunk ./src/State.hs 69
+ , stShape = "circle"
+ , stActiveCanvas = Net
hunk ./src/State.hs 88
+getLHSCanvas :: State g n e -> IO (ScrolledWindow ())
+getLHSCanvas = getFromState stLHSCanvas
+
+getRHSCanvas :: State g n e -> IO (ScrolledWindow ())
+getRHSCanvas = getFromState stRHSCanvas
+
hunk ./src/State.hs 106
+getActiveCanvas :: State g n e -> IO ActiveCanvas
+getActiveCanvas = getFromState stActiveCanvas
+
+getActiveRule :: State g n e -> IO RuleName
+getActiveRule = getFromState stActiveRule
+
+getTree :: State g n e -> IO (TreeCtrl () )
+getTree = getFromState stTree
+
hunk ./src/State.hs 129
+setLHSCanvas :: ScrolledWindow () -> State g n e -> IO ()
+setLHSCanvas canvas stateRef =
+ varUpdate_ stateRef (\state -> state { stLHSCanvas = canvas })
+
+setRHSCanvas :: ScrolledWindow () -> State g n e -> IO ()
+setRHSCanvas canvas stateRef =
+ varUpdate_ stateRef (\state -> state { stRHSCanvas = canvas })
+
hunk ./src/State.hs 149
-setCurrentShape :: String -> State g n e -> IO ()
-setCurrentShape shapeName stateRef =
- varUpdate_ stateRef (\state -> state { stShape = shapeName })
-
hunk ./src/State.hs 153
+
+setCurrentShape :: String -> State g n e -> IO ()
+setCurrentShape shapeName stateRef =
+ varUpdate_ stateRef (\state -> state { stShape = shapeName })
+
+setActiveCanvas :: ActiveCanvas -> State g n e -> IO ()
+setActiveCanvas activeCanvas stateRef =
+ do rule <- getActiveRule stateRef
+ let activeCanvas' = case activeCanvas of
+ Net -> Net
+ LHS str | null str -> LHS rule
+ | otherwise -> LHS str
+ RHS str | null str -> RHS rule
+ | otherwise -> RHS str
+ varUpdate_ stateRef (\state -> state { stActiveCanvas = activeCanvas' })
+
+setActiveRule :: RuleName -> State g n e -> IO ()
+setActiveRule activeRule stateRef =
+ varUpdate_ stateRef (\state -> state { stActiveRule = activeRule })
+
+setTree :: TreeCtrl () -> State g n e -> IO ()
+setTree tree stateRef =
+ varUpdate_ stateRef (\state -> state { stTree = tree })
hunk ./src/StateUtil.hs 15
- do{ canvas <- getCanvas state
+ do{ canvas <- getCanvas state
+ ; canvasLHS <- getLHSCanvas state
+ ; canvasRHS <- getRHSCanvas state
hunk ./src/StateUtil.hs 19
+ ; Graphics.UI.WX.repaint canvasLHS
+ ; Graphics.UI.WX.repaint canvasRHS
}