implementation module GinORYXStencil import StdArray import StdEnum import StdList import StdOrdList import GenEq import JSON import Text import GinSyntax import GinORYX import GinSVG import GinFlowLibrary import Util derive gEq ORYXStencilSet, ORYXStencil, ORYXRules, ORYXConnectionRule, ORYXConnect, ORYXContainmentRule, ORYXMorphingRule derive JSONEncode ORYXStencilSet, ORYXStencil, ORYXRules, ORYXConnectionRule, ORYXContainmentRule, ORYXMorphingRule derive JSONDecode ORYXStencilSet, ORYXStencil, ORYXRules, ORYXConnectionRule, ORYXContainmentRule, ORYXMorphingRule JSONEncode{|ORYXConnect|} {from_, to} = [JSONObject [ ("from", toJSON from_) , ("to", toJSON to) ] ] JSONDecode{|ORYXConnect|} [node:nodes] # mFrom = jsonQuery "from" node # mTo = jsonQuery "to" node | isNothing mFrom = (Nothing, nodes) | isNothing mTo = (Nothing, nodes) = (Just { ORYXConnect | from_ = fromJust mFrom , to = fromJust mTo } , nodes) makeStencilSet :: GModule -> ORYXStencilSet makeStencilSet gMod # decls = [ (gMod.GModule.name,bt,decl) \\ (bt,decl) <- getModuleDeclarations gMod] = { ORYXStencilSet | title = "Graphical iTask Notation" , namespace = "http://mbsd.icis.ru.nl/itasks/gin/" +++ gMod.GModule.name +++ "#" , description = "A graphical notation for iTask workflows" , baseUrl = Just "gin" , extends = Just "http://mbsd.icis.ru.nl/itasks/gin#" , stencils = map declToStencil decls , rules = { ORYXRules | connectionRules = [] , containmentRules = [] , morphingRules = [] } } predefinedStencilSet :: ORYXStencilSet predefinedStencilSet # decls = [ (predefinedModule.GModule.name,bt,decl) \\ (bt,decl) <- getModuleDeclarations predefinedModule] = { ORYXStencilSet | title = "Graphical iTask Notation" , namespace = "http://mbsd.icis.ru.nl/itasks/gin#" , description = "A graphical notation for iTask workflows" , baseUrl = Just "gin" , extends = Nothing , stencils = [diagramStencil, arcStencil] ++ map declToStencil decls , rules = { ORYXRules | connectionRules = [ { ORYXConnectionRule | role = "arc" , connects = [ { ORYXConnect | from_ = "single" , to = ["single", "split", "merge"] } , { ORYXConnect | from_ = "split" , to = ["single", "split", "merge"] } , { ORYXConnect | from_ = "merge" , to = ["single", "split", "merge"] } ] } ] , containmentRules = [ { ORYXContainmentRule | role = "diagram" , contains = ["all"] } , { ORYXContainmentRule | role = "higherOrderTask" , contains = ["all"] } ] , morphingRules = [ { ORYXMorphingRule | role = "single" , baseMorphs = ["single"] } , { ORYXMorphingRule | role = "split" , baseMorphs = ["split"] } , { ORYXMorphingRule | role = "merge" , baseMorphs = ["merge"] } ] } } diagramStencil :: ORYXStencil diagramStencil = { ORYXStencil | type = "node" , id = "Diagram" , title = "Diagram" , groups = [] , description = "A Diagram" , view = toString diagramView , icon = "new_diagram.png" , mayBeRoot = True , roles = ["diagram"] , properties = [] } diagramView :: SVGShape diagramView = { SVGShape | width = 800 , height = 600 , defs = [] , magnets = False , elements = [ SVGRect Nothing ((XLeft, YTop),(XRight,YBottom)) 0 0 [ SVGStroke "black" , SVGFill "black" , SVGStrokeWidth 1 , SVGStrokeLineCap "butt" , SVGStrokeLineJoin "miter" , SVGStrokeMiterLimit 10 ] , SVGRect (Just "diagramcanvas") ((XLeft,YTop),(XRight, YBottom)) 0 0 [ SVGStroke "black" , SVGStrokeWidth 2 , SVGFill "white" ] , SVGText (Just "diagramtext") (XAbs 400, YAbs 25) "" [SVGStroke "black"] ] } arcStencil :: ORYXStencil arcStencil = { ORYXStencil | type = "edge" , id = "Arc" , title = "Arc" , groups = [] , description = "" , view = toString arcView , icon = "new_flow.png" , mayBeRoot = False , roles = ["all", "arc" ] , properties = [ ORYXProperties [ { ORYXProperty| key = "id" , value = JSONString "pattern"} , { ORYXProperty| key = "type" , value = JSONString "String"} , { ORYXProperty| key = "title" , value = JSONString "Pattern"} , { ORYXProperty| key = "value" , value = JSONString ""} , { ORYXProperty| key = "description" , value = JSONString ""} , { ORYXProperty| key = "tooltip" , value = JSONString ""} , { ORYXProperty| key = "readonly" , value = JSONBool False} , { ORYXProperty| key = "optional" , value = JSONBool True} , { ORYXProperty| key = "refToView" , value = JSONString "pattern"} , { ORYXProperty| key = "length" , value = JSONString ""} , { ORYXProperty| key = "wrapLines" , value = JSONBool False} ] ] } where arcView :: SVGShape arcView = { SVGShape | width = 250 , height = 250 , defs = [ XMLElem (uname "marker") [ XMLAttr (uname "id") "end" , XMLAttr (uname "refX") "15" , XMLAttr (uname "refY") "5" , XMLAttr (uname "markerUnits") "userSpaceOnUse" , XMLAttr (uname "markerWidth") "15" , XMLAttr (uname "markerHeight") "10" , XMLAttr (uname "orient") "auto" ] [ XMLElem (uname "path") [ XMLAttr (uname "d") "M 0 0 L 15 5 L 0 10 L 0 0" , XMLAttr (uname "fill") "black" , XMLAttr (uname "stroke") "black" ] [] ] ] , magnets = False , elements = [ SVGPath (Just "arc") "M10 50 L210 50" [ SVGStroke "black" , SVGFill "none" , SVGStrokeWidth 2 , SVGStrokeLineCap "round" , SVGStrokeLineJoin "round" , SVGMarkerEnd "url(#end)" ] , SVGText (Just "pattern") (XAbs 47, YAbs 7) "" [SVGEdgePosition "midtop"] ] } declToStencil :: (!String, !BranchType, GDeclaration) -> ORYXStencil declToStencil (group,branchtype,gDecl) # morphrole = case branchtype of BTSingle = "single" BTSplit = "split" BTMerge = "merge" # icon = fromMaybe "task" gDecl.GDeclaration.icon = { ORYXStencil | type = "node" , id = gDecl.GDeclaration.name , title = fromMaybe (camelCaseToWords gDecl.GDeclaration.name) gDecl.GDeclaration.title , groups = [group] , description = fromMaybe "" gDecl.GDeclaration.description , view = case gDecl.GDeclaration.shape of GDefaultShape = toString (case branchtype of BTSingle = defaultTaskShape gDecl BTSplit = defaultConnectorShape icon BTMerge = defaultConnectorShape icon ) GBuiltInShape shape = toString shape GExternalShape filename = filename +++ ".svg" , icon = icon +++ ".png" , mayBeRoot = False , roles = ["all", morphrole] ++ if (isHigherOrder gDecl) ["higherOrderTask"] [] , properties = map formalParameterToProperty gDecl.GDeclaration.formalParams } formalParameterToProperty :: GFormalParameter -> ORYXProperties formalParameterToProperty param = ORYXProperties [ { ORYXProperty| key = "id" , value = JSONString param.GFormalParameter.name} , { ORYXProperty| key = "type" , value = JSONString "String"} , { ORYXProperty| key = "title" , value = JSONString (fromMaybe param.GFormalParameter.name param.GFormalParameter.title) } , { ORYXProperty| key = "value" , value = JSONString (fromMaybe "" param.GFormalParameter.defaultValue) } , { ORYXProperty| key = "description" , value = JSONString (fromMaybe "" param.GFormalParameter.description) } , { ORYXProperty| key = "tooltip" , value = JSONString ""} , { ORYXProperty| key = "readonly" , value = JSONBool False} , { ORYXProperty| key = "optional" , value = JSONBool True} , { ORYXProperty| key = "refToView" , value = JSONString param.GFormalParameter.name} , { ORYXProperty| key = "length" , value = JSONString ""} , { ORYXProperty| key = "wrapLines" , value = JSONBool True} ] isHigherOrder :: GDeclaration -> Bool isHigherOrder decl = any higherOrderParam decl.GDeclaration.formalParams higherOrderParam :: GFormalParameter -> Bool higherOrderParam param = case param.GFormalParameter.type of GTypeApplication [GConstructor "Task": _] = True _ = False defaultTaskShape :: GDeclaration -> SVGShape defaultTaskShape gDecl # visibleParams = [ p \\ p <- gDecl.GDeclaration.formalParams | p.GFormalParameter.visible ] # title = fromMaybe (camelCaseToWords gDecl.GDeclaration.name) gDecl.GDeclaration.title # paramWidth = strWidth [ fromMaybe p.GFormalParameter.name p.GFormalParameter.title \\ p <- visibleParams ] = { SVGShape | width = maxList [20 + strWidth [title], paramWidth + 100] , height = 20 + 20 * length visibleParams , defs = [] , magnets = True , elements = [ SVGRect Nothing ((XLeft, YTop),(XRight, YBottom)) 5 5 ([SVGStroke "black", SVGFill "white"] ++ ifParams [SVGResize "horizontal vertical"]) , SVGImage Nothing ((XAbs 2, YAbs 2), (XAbs 18, YAbs 18)) (fromMaybe "task" gDecl.GDeclaration.icon +++ ".png") [SVGAnchors "top left"] , SVGText Nothing (XAbs 20, YAbs 13) title [SVGAnchors "top left"] ] ++ ifParams [ SVGLine Nothing ((XLeft, YAbs 20), (XRight, YAbs 20)) [SVGAnchors "top left right"] , SVGLine Nothing ((XAbs paramWidth, YAbs 20), (XAbs paramWidth, YBottom)) [SVGAnchors "top left bottom"] ] ++ flatten (map (\(nr,param) -> [ SVGText Nothing (XAbs 3, YAbs (13 + 20 * nr)) (fromMaybe param.GFormalParameter.name param.GFormalParameter.title) [] , SVGText (Just param.GFormalParameter.name ) (XAbs (paramWidth + 3), YAbs (13 + 20 * nr)) "" [SVGAnchors "left"] ] ++ if (nr > 1) [SVGLine Nothing ((XLeft, YAbs (20 * nr)), (XRight, YAbs (20 * nr))) [SVGAnchors "left right"]] [] ) (zip2 [1..] visibleParams)) } where strWidth :: [String] -> Int strWidth [] = 0 strWidth ss = maxList [ 8 * size s \\ s <- ss ] ifParams :: [a] -> [a] ifParams x = if (isEmpty [ p \\ p <- gDecl.GDeclaration.formalParams | p.GFormalParameter.visible ]) [] x defaultConnectorShape :: String -> SVGShape defaultConnectorShape icon = { SVGShape | width = 20 , height = 20 , defs = [] , magnets = True , elements = [ SVGEllipse Nothing ((XLeft, YTop),(XRight, YBottom)) ([SVGStroke "black", SVGFill "white"]) , SVGImage Nothing ((XAbs 2, YAbs 2), (XAbs 18, YAbs 18)) (icon +++ ".png") [] ] }