Commit bf00d243 authored by Michael Westergaard's avatar Michael Westergaard
Browse files

Graphical support for inhibitor and reset arcs

Graphical support (mostly) for FIFO/LIFO/PQueue/Bounded places

Support for low-level nets

Graphical tweaks for regular arcs and port places

Initial support for Declare constraints (does not work and code does not compile ATM)
parent 3c47adf2
......@@ -83,6 +83,7 @@ BODY 'private/cpnetmonitorbody';
BODY 'private/cpnetmonitorblockbody';
BODY 'private/cpnetmonitormlcommandsbody';
BODY 'private/cpnetregistercommandbody';
BODY 'private/cpnetdeclarebody.bet';
-- textLib: Attributes --
......@@ -199,6 +200,8 @@ PageList: List (# Element:: CPNPage; #);
CPNPageList: List (# Element:: CPNPage; #);
ArcList: List (# Element:: Arc; #);
SSArcList: List (# Element:: SSArc; #);
ConstraintArcList: List (# Element:: ConstraintArc; #);
ConstraintInscriptionList: List (# Element:: ConstraintInscription; #);
InscriptionList: List (# Element:: Inscription; #);
DeclList: List (# Element:: Decl; #);
OptionSmartList: Smartlist (# ElementType:: Option; #);
......@@ -240,6 +243,10 @@ PageElementList: SmartList
(# current: ^SSArc;
<<SLOT PageElementListScanSSArcs:DoPart>>
#);
scanConstraintArcs:
(# current: ^SSArc;
<<SLOT PageElementListScanSSArcs:DoPart>>
#);
scanNodes:
(# current: ^Node;
<<SLOT PageElementListScanNodes:DoPart>>
......@@ -464,6 +471,7 @@ PageInstanceIdDictionary: NotifierIdDictionary (# Element:: PageInstance; #);
PlaceInstanceIDDictionary: NotifierIdDictionary (# Element:: PlaceInstance; #);
TransitionInstanceIDDictionary: NotifierIdDictionary (# Element:: TransitionInstance; #);
ArcInstanceIDDictionary: NotifierIdDictionary (# Element:: ArcInstance; #);
ConstraintArcInstanceIDDictionary: NotifierIdDictionary (# Element:: ConstraintArcInstance; #);
PlaceIDDictionary: NotifierIdDictionary (# Element::Place; #);
PageElementIDDictionary: NotifierIDDictionary
(# Element::< PageElement;
......@@ -472,6 +480,7 @@ PageElementListIDDictionary: IdDictionary (# Element:: PageElementList; #);
FusionSetIDDictionary: IdDictionary (# Element:: FusionSet; #);
TransitionIDDictionary: IdDictionary (# Element::Transition; #);
ArcIDDictionary: IdDictionary (# Element::Arc; #);
ConstraintArcIDDictionary: IdDictionary (# Element::ConstraintArc; #);
BendpointListIDDictionary: IdDictionary (# Element:: BendpointList; #);
AuxIDDictionary: IdDictionary (# Element:: Aux; #);
SSNodeIDDictionary: IdDictionary (# Element:: SSNode; #);
......@@ -1247,6 +1256,7 @@ CPNPage: Highlightable
lookupPlace: Lookup (# Element:: Place <<SLOT CPNPageLookupPlace:doPart>> #);
lookupTransition: Lookup (# Element:: Transition <<SLOT CPNPageLookupTransition:doPart>> #);
lookupArc: Lookup (# Element:: Arc <<SLOT CPNPageLookupArc:doPart>> #);
lookupConstraintArc: Lookup (# Element:: ConstraintArc <<SLOT CPNPageLookupConstraintArc:doPart>> #);
lookupSSNode: Lookup (# Element:: SSNode <<SLOT CPNPageLookupSSNode:doPart>> #);
lookupPageElement: Lookup (# Element:: PageElement <<SLOT CPNPageLookupPageElement:doPart>> #);
lookupTopCPNPage: Lookup (# Element:: CPNPage <<SLOT CPNPageLookupTopCPNPage:doPart>> #);
......@@ -1291,6 +1301,10 @@ CPNPage: Highlightable
(# current: ^Arc;
<<SLOT CPNPageScanArcs:doPart>>
#);
scanConstraintArcs:
(# current: ^ConstraintArc;
<<SLOT CPNPageScanConstraintArcs:doPart>>
#);
scanGuidelines:
(# current: ^Guideline;
<<SLOT CPNPageScanGuidelines:doPart>>
......@@ -1342,6 +1356,11 @@ CPNPage: Highlightable
enter theArc[]
<<SLOT CPNPageAddArc:doPart>>
#);
addConstraintArc:
(# theConstraintArc: ^ConstraintArc;
enter theConstraintArc[]
<<SLOT CPNPageAddConstraintArc:doPart>>
#);
addGuideline:
(# theGuideline: ^Guideline;
enter theGuideline[]
......@@ -1399,6 +1418,11 @@ CPNPage: Highlightable
enter theArc[]
<<SLOT CPNPageRemoveArc:doPart>>
#);
removeConstraintArc:
(# theConstraintArc: ^ConstraintArc;
enter theConstraintArc[]
<<SLOT CPNPageRemoveConstraintArc:doPart>>
#);
removeGuideline:
(# theGuideline: ^Guideline;
enter theGuideline[]
......@@ -1817,6 +1841,10 @@ PageInstance: Highlightable
(# Element:: ArcInstance;
<<SLOT PageInstanceLookupArcInstance:doPart>>
#);
lookupConstraintArcInstance: lookup
(# Element:: ConstraintArcInstance;
<<SLOT PageInstanceLookupConstraintArcInstance:doPart>>
#);
lookupNodeInstance: lookup
(# Element:: NodeInstance;
<<SLOT PageInstanceLookupNodeInstance:DoPart>>
......@@ -1922,11 +1950,22 @@ PageInstance: Highlightable
enter theArc[]
<<SLOT PageInstanceAddArc:DoPart>>
#);
addConstraintArc:
(# theConstraintArc: ^ConstraintArc;
theConstraintArcInstance: ^ConstraintArcInstance;
enter theConstraintArc[]
<<SLOT PageInstanceAddConstraintArc:DoPart>>
#);
removeArc:
(# theArc: ^Arc;
enter theArc[]
<<SLOT PageInstanceRemoveArc:DoPart>>
#);
removeConstraintArc:
(# theConstraintArc: ^ConstraintArc;
enter theConstraintArc[]
<<SLOT PageInstanceRemoveConstraintArc:DoPart>>
#);
init::
(# superPageInstance: ^PageInstance;
enter superPageInstance[]
......@@ -2521,6 +2560,23 @@ ArcInstance: NodeInstance
onChanged:: (# <<SLOT ArcInstanceOnChanged:DoPart>> #);
#);
ConstraintArcInstance: NodeInstance
(# private: @<<SLOT ConstraintArcInstancePrivate:Descriptor>>;
theConstraintArc: ^ConstraintArc;
thePageInstance: ^PageInstance;
init:: (# <<SLOT ConstraintArcInstanceInit:DoPart>> #);
update:: (# <<SLOT ConstraintArcInstanceUpdate:DoPart>> #);
delete:: (# <<SLOT ConstraintArcInstanceDelete:DoPart>> #);
status:: (# <<SLOT ConstraintArcInstanceStatus:DoPart>> #);
getCurrentHighlight:: (# <<SLOT ConstraintArcInstanceGetCurrentHighlight:DoPart>> #);
setSimulationError:
(# error: @boolean;
enter error
<<SLOT ConstraintArcInstanceSetSimulationError:DoPart>>
#);
onChanged:: (# <<SLOT ConstraintArcInstanceOnChanged:DoPart>> #);
#);
PageElement: Snapable
(# private: @<<SLOT PageElementPrivate:descriptor>>;
ignore: @boolean;
......@@ -3001,7 +3057,23 @@ Transition: CPNNode
(# current: ^Place;
<<SLOT TransitionScanSurroundingPlaces:DoPart>>
#);
changeStatus:: (# <<SLOT TransitionChangeStatus:doPart>> #);
changeStatus:: (# <<SLOT TransitionChangeStatus:doPart>> #);
addConstraintArc:<
(# theConstraintArc: ^ConstraintArc;
enter theConstraintArc[]
<<SLOT TransitionAddConstraintArc:DoPart>>
#);
removeConstraintArc:<
(# theConstraintArc: ^ConstraintArc;
enter theConstraintArc[]
<<SLOT TransitionRemoveConstraintArc:DoPart>>
#);
scanConstraintArcs:
(# current: ^ConstraintArc;
<<SLOT TransitionScanConstraintArcs:doPart>>
#);
hasConstraintArcs: BooleanValue (# <<SLOT TransitionHasConstraintArcs:DoPart>> #);
menuName::<
(#
......@@ -3410,6 +3482,11 @@ Place: CPNNode
enter thePortType[]
<<SLOT PlaceSetPortType:doPart>>
#);
SetPlaceKind:
(# thePlaceKind: ^PlaceKind;
enter thePlaceKind[]
<<SLOT PlaceSetPlaceKind:doPart>>
#);
Clone::
(# Type:: Place;
<<SLOT PlaceClone:doPart>>
......@@ -3449,8 +3526,15 @@ Place: CPNNode
<<SLOT PlaceGetPortType:doPart>>
exit thePortType[]
#);
getPlaceKind:
(# thePlaceKind: ^PlaceKind;
<<SLOT PlaceGetPlaceKind:doPart>>
exit thePlaceKind[]
#);
hasPortType: BooleanValue
(# <<SLOT PlaceHasPortType:doPart>> #);
hasPlaceKind: BooleanValue
(# <<SLOT PlaceHasPlaceKind:doPart>> #);
createPortType:
(# thePortType: ^PortType;
cpnml: ^Text;
......@@ -3458,6 +3542,13 @@ Place: CPNNode
<<SLOT PlacecreatePortType:doPart>>
exit thePortType[]
#);
createPlaceKind:
(# thePlaceKind: ^PlaceKind;
cpnml: ^Text;
enter cpnml[]
<<SLOT PlacecreatePlaceKind:doPart>>
exit thePlaceKind[]
#);
getFusionInfo:
(# theFusionInfo: ^FusionInfo;
<<SLOT PlaceGetFusionInfo:doPart>>
......@@ -3505,9 +3596,40 @@ Place: CPNNode
#);
makeShape::
(# ItemType:: Ellipse;
do width -> theItem.width;
height -> theItem.height;
(# ItemType:: Composite;
theLine: ^Line;
theEllipse: ^Ellipse;
do (if not (hasPlaceKind) then
&Ellipse[] -> theEllipse[];
theEllipse.init;
width -> theEllipse.width;
height -> theEllipse.height;
theEllipse[] -> theItem.add;
(if hasPortType then
&Ellipse[] -> theEllipse[];
theEllipse.init;
width - 8 -> theEllipse.width;
height - 8 -> theEllipse.height;
1 -> &StrokeWidthStyle -> theEllipse.theStyle[];
theEllipse[] -> theItem.add;
if);
else
(# points: ^PointList;
do &PointList[] -> points[];
(0, -height/2) -> makePoint -> points.append;
(width/2, -height/2) -> makePoint -> points.append;
(width/2, height/2) -> makePoint -> points.append;
(0, height/2) -> makePoint -> points.append;
(-width/2, height/2) -> makePoint -> points.append;
(-width/2, -height/2) -> makePoint -> points.append;
(0, -height/2) -> makePoint -> points.append;
&Line[] -> theLine[];
theLine.init;
15.0 -> &CurvatureStyle -> theLine.theStyle[];
points[] -> theLine.points[];
theLine[] -> theItem.add;
#);
if);
#);
getIntersect::
(# <<SLOT PlaceGetIntersect:doPart>> #);
......@@ -3589,6 +3711,8 @@ Place: CPNNode
BothDir: (# exit 1 #);
PtoT: (# exit 2 #);
TtoP: (# exit 3 #);
Inhibitor: (# exit 4 #);
ResetArc: (# exit 5 #);
ArcDistance: (# exit 14 #);
......@@ -4114,6 +4238,13 @@ PlaceType: PlaceInscription
onSemanticChanged:: (# <<SLOT PlaceTypeOnSemanticChanged:doPart>> #);
onFocusLost:: (# <<SLOT PlaceTypeOnFocusLost:DoPart>> #);
init:: (# <<SLOT PlaceTypeInit:DoPart>> #);
getType: (# result: ^text;
do getInscription -> result[];
(if (result[] = NONE) or ('' -> result.equal) then
'UNIT' -> result[];
if);
exit result[]
#);
#);
InitMark: PlaceInscription
......@@ -4221,6 +4352,32 @@ PortType: HierarchyInfo
snap:: (# <<SLOT PortTypeSnap:doPart>> #);
#);
PlaceKind: HierarchyInfo
(# private: @<<SLOT PlaceKindPrivate:Descriptor>>;
setPlace:
(# thePlace: ^Place;
enter thePlace[]
<<SLOT PlaceKindSetPlace:doPart>> #);
getPlace:
(# thePlace: ^Place;
<<SLOT PlaceKindGetPlace:doPart>>
exit thePlace[]
#);
defaultSnapToElement:: (# <<SLOT PlaceKindDefaultSnapToElement:doPart>> #);
menuName::<
(#
do NamesPageMenuPlaceKind -> getGlobalNames -> txt[];
INNER;
#);
clone:: (# type:: PlaceKind; #);
delete:: (# <<SLOT PlaceKindDelete:doPart>> #);
update:: (# <<SLOT PlaceKindUpdate:doPart>> #);
next:: (# <<SLOT PlaceKindNext:doPart>> #);
onSemanticChanged:: (# <<SLOT PlaceKindOnSemanticChanged:doPart>> #);
onChanged:: (# <<SLOT PlaceKindOnChanged:doPart>> #);
snap:: (# <<SLOT PlaceKindSnap:doPart>> #);
#);
SubPageInfo: HierarchyInfo
(# private: @<<SLOT SubPageInfoPrivate:descriptor>>;
setTransition:
......@@ -5272,6 +5429,29 @@ SSArc: Arc
(# <<SLOT SSArcMenuName:doPart>> #);
#);
ConstraintArc: Arc
(#
number, srcNode, destNode: @Integer;
descriptor: ^Text;
delta: @Point2d;
visible: @boolean;
deadInfo: @boolean;
dead:
(# d: @Boolean;
enter
(#
enter d
do (if (d AND (NOT deadInfo) and (((0.0, 0.0, 0.0) -> &Color) -> (getColor).equal)) then (0.5, 0.5, 0.5) -> &Color -> setColor; if);
d -> deadInfo;
#)
exit deadInfo
#);
deleteFromPage:: (# do THIS(ConstraintArc)[] -> (getCPNPage).removeConstraintArc; #);
update:: (# <<SLOT ConstraintArcUpdate:doPart>> #);
menuName::<
(# <<SLOT ConstraintArcMenuName:doPart>> #);
#);
(*
* This is for keeping the functionality of CPNet nodes, i.e.
* Places and Transisions, seperate from other nodes
......
......@@ -30,6 +30,7 @@ INCLUDE '../cpntools/cpnworkspace';
INCLUDE 'private/xmlgetdata';
INCLUDE '../cpntools/instruments/cpninstrument';
INCLUDE '../cpntools/resources/texts/texts';
INCLUDE '~beta/basiclib/regexp';
-- WorkspaceLib: attributes --
Loader:
......@@ -421,6 +422,26 @@ CPNetLoader: Loader
getPlace -> obj.setPlace;
#);
#);
PlaceKindLoader: @PageElementLoader
(# Type:: PlaceKind;
load::
(#
do 'type' -> elm.lookuptext -> obj.setCPNML;
(if ('fifo'->(obj.getCPNML).equalNCS) then
'fifo'->obj.setCPNML;
if);
(if 'lifo'->(obj.getCPNML).equalNCS then
'lifo'->obj.setCPNML;
if);
(if 'pqueue'->(obj.getCPNML).equalNCS then
'pqueue'->obj.setCPNML;
if);
(if 'bounded'->(obj.getCPNML).equalNCS then
'bounded'->obj.setCPNML;
if);
getPlace -> obj.setPlace;
#);
#);
FusionInfoLoader: @HierarchyInfoLoader
(# Type:: FusionInfo;
......@@ -464,6 +485,8 @@ CPNetLoader: Loader
#);
//'port' -> current.tag.equalNCS then
current[] -> PortTypeLoader.load -> obj.setPortType;
//'kind' -> current.tag.equalNCS then
current[] -> PlaceKindLoader.load -> obj.setPlaceKind;
// 'fusioninfo' -> current.tag.equalNCS then
current[] -> FusionInfoLoader.load -> obj.setFusionInfo;
if);
......@@ -474,7 +497,15 @@ CPNetLoader: Loader
(if obj.getPlaceType = NONE then
PlaceTypeLoader.createDefault;
if);
(if (obj.getPlaceType = NONE) or
('UNIT' -> ((obj.getPlaceType).getType).equal) then
0 -> ((obj.getInitMark).getInscription).pos;
'^ *\\([0-9]+\\) *`() *$' -> ((obj.getInitMark).getInscription).regexp_match (#
do ((1 -> regs.start) + 1, 1 -> regs.end) -> ((obj.getInitMark).getInscription).sub -> (obj.getInitMark).setInscription;
#);
if);
obj[] -> (getPage).addPlace;
obj.getInitMark -> snapChild;
......@@ -794,6 +825,10 @@ CPNetLoader: Loader
PtoT->obj.setOrientation;
//'TtoP'->dir.equalNCS then
TtoP->obj.setOrientation;
//'inhibitor'->dir.equalNCS then
Inhibitor->obj.setOrientation;
//'reset'->dir.equalNCS then
ResetArc->obj.setOrientation;
else
(if debugging then
'Arc.unPackAttributes: Unknown arc orientation: %s'->debugCPNet
......@@ -846,7 +881,21 @@ CPNetLoader: Loader
idref[] -> lookupObject -> placeEnd[];
(if placeEnd[] <> NONE then
placeEnd[] -> obj.setPlaceEnd;
obj[] -> placeEnd.addArc;
obj[] -> placeEnd.addArc;
(if (placeEnd.getPlaceType = NONE) or
('UNIT' -> ((placeEnd.getPlaceType).getType).equal) then
0 -> ((obj.getAnnotation).getInscription).pos;
'^ *\\([0-9]+\\) *`() *$' -> ((obj.getAnnotation).getInscription).regexp_match (#
do ((1 -> regs.start) + 1, 1 -> regs.end) -> ((obj.getAnnotation).getInscription).sub -> (obj.getAnnotation).setInscription;
#);
(if '1' -> ((obj.getAnnotation).getInscription).equal then
AnnotationLoader.createDefault;
if);
(if '()' -> ((obj.getAnnotation).getInscription).equal then
AnnotationLoader.createDefault;
if);
if)
if);
if);
//'transend'->current.tag.equalNCS then
......
......@@ -23,174 +23,180 @@
(* You should have received a copy of the GNU General Public License *)
(* along with CPN Tools. If not, see <http://www.gnu.org/licenses/>. *)
(************************************************************************)
ORIGIN 'cpnet';
-- Workspacelib: attributes --
(* ------------------ visitor outline for new pack code ----------- *)
NetVisitor:
(# init:< (# do INNER; #);
visitCPNet:<
(# current: ^CPNet;
enter current[]
do INNER;
#);
visitFusionSet:<
(# current: ^FusionSet;
enter current[]
do INNER;
#);
visitGlobals:<
(# current: ^Globals;
enter current[]
do INNER;
#);
visitCPNPage:<
(# current: ^CPNPage;
enter current[]
do INNER;
#);
visitPlace:<
(# current: ^Place;
enter current[]
do INNER;
#);
visitPlaceType:<
(# current: ^PlaceType;
enter current[]
do INNER;
#);
visitInitMark:<
(# current: ^InitMark;
enter current[]
do INNER;
#);
visitPortType:<
(# current: ^PortType;
enter current[]
do INNER;
#);
visitFusionInfo:<
(# current: ^FusionInfo;
enter current[]
do INNER;
#);
visitTransition:<
(# current: ^Transition;
enter current[]
do INNER;
#);
visitTransTime:<
(# current: ^TransTime;
enter current[]
do INNER;
#);
visitTransGuard:<
(# current: ^TransGuard;
enter current[]
do INNER;
#);
visitTransAction:<
(# current: ^TransAction;
enter current[]
do INNER;
#);
visitTransChannel:<
(# current: ^TransChannel;
enter current[]
do INNER;
#);
visitTransPriority:<
(# current: ^TransPriority;
enter current[]
do INNER;
#);
visitArc:<
(# current: ^Arc;
enter current[]
do INNER;
#);
visitAnnotation:<
(# current: ^Annotation;
enter current[]
do INNER;
#);
visitSubPageInfo:<
(# current: ^SubPageInfo;
enter current[]
do INNER;
#);
visitSSArc:<
(# current: ^SSArc;
enter current[]
do INNER;
#);
visitSSNode:<
(# current: ^SSNode;
enter current[]
do INNER;
#);
visitBendPoint:<
(# current: ^BendPoint;
enter current[]
do INNER;
#);
visitAux:<
(# current: ^Aux;
enter current[]
do INNER;
#);
visitGroup:<
(# current: ^Group;
enter current[]
do INNER;
#);
visitHorizontalGuideline:<
(# current: ^HorizontalGuideline;
enter current[]
do INNER;
#);
visitVerticalGuideLine:<
(# current: ^VerticalGuideline;
enter current[]
do INNER;
#);
visitMonitor:<
(# current: ^Monitor;
enter current[]
do inner;
#);
visitMonitorBlock:<
(# current: ^MonitorBlock;
enter current[]
do inner;
#);
#);
(* ----------------------- end visitor --------------------- *)
ORIGIN 'cpnet';
-- Workspacelib: attributes --
(* ------------------ visitor outline for new pack code ----------- *)
NetVisitor:
(# init:< (# do INNER; #);
visitCPNet:<
(# current: ^CPNet;
enter current[]
do INNER;
#);
visitFusionSet:<
(# current: ^FusionSet;
enter current[]
do INNER;
#);
visitGlobals:<
(# current: ^Globals;
enter current[]
do INNER;
#);
visitCPNPage:<
(# current: ^CPNPage;
enter current[]
do INNER;
#);
visitPlace:<
(# current: ^Place;
enter current[]
do INNER;
#);
visitPlaceType:<
(# current: ^PlaceType;
enter current[]
do INNER;
#);
visitInitMark:<
(# current: ^InitMark;
enter current[]
do INNER;
#);
visitPortType:<
(# current: ^PortType;
enter current[]
do INNER;
#);
visitPlaceKind:<
(# current: ^PlaceKind;
enter current[]
do INNER;
#);