Migrated source code from Simantics SVN

[simantics/platform.git] / bundles / org.simantics.modeling / scl / Simantics / DiagramMapping.scl

diff --git a/bundles/org.simantics.modeling/scl/Simantics/DiagramMapping.scl b/bundles/org.simantics.modeling/scl/Simantics/DiagramMapping.scl
new file mode 100644 (file)
index 0000000..7686eeb
--- /dev/null
+++ b/bundles/org.simantics.modeling/scl/Simantics/DiagramMapping.scl
@@ -0,0 +1,124 @@
+import "Simantics/DB"\r
+import "Extras/HashMap" as Map\r
+import "Simantics/Entity"\r
+import "Simantics/Model"\r
+import "Simantics/Diagram"\r
+\r
+import "http://www.simantics.org/Modeling-1.2" as MOD\r
+import "http://www.simantics.org/ModelingTemplate2d-1.0" as TMPL\r
+\r
+applyConnectionTypes :: Map.T (DiagramElement Resource) (Resource,Resource) -> <Proc,WriteGraph,ReadGraph> ()\r
+applyConnectionTypes elementMap = \r
+    let\r
+        isConnection ((Connection _ _ _),_) = True\r
+        isConnection _ = False\r
+    in iter (\(a,(source,target)) -> applyConnectionType target) (filter isConnection (Map.entries elementMap))\r
+   \r
+\r
+// ----\r
+\r
+doElementPostProcessing (elementMap :: Map.T (DiagramElement Resource) (Resource,Resource))\r
+                        (elementPostProcessing :: DiagramElement Resource -> Resource -> Resource -> <Proc,ReadGraph,WriteGraph> ()) = do\r
+    list = sortByCluster (Map.entries elementMap) (\(a,(source,target)) -> target)\r
+    iter (\(a,(source,target)) -> elementPostProcessing a source target) list\r
+\r
+translateDiagrams (sourceModel :: Model)\r
+                 (targetModel :: Model)\r
+                 (folderType :: Resource) \r
+                 (compositeType :: Resource)\r
+                 (diagramConstructor :: Diagram -> <ReadGraph> [(DiagramElement Resource,Resource)])\r
+                 (diagramPostProcessing :: Diagram -> Diagram -> <Proc,ReadGraph,WriteGraph> ()) \r
+                 (elementPostProcessing :: DiagramElement Resource -> Resource -> Resource -> <Proc,ReadGraph,WriteGraph> ()) \r
+                 (sourceDiagrams :: [Diagram]) = do\r
+                 \r
+  elementMap = Map.create() :: Map.T (DiagramElement Resource) (Resource,Resource)\r
+\r
+  // Join map contains all joins of the model\r
+  joinMap = createJoinMap ()\r
+  \r
+  for sourceDiagrams\r
+    (translateDiagram sourceModel targetModel folderType \r
+        compositeType diagramConstructor joinMap \r
+        elementMap diagramPostProcessing)\r
+\r
+  applyConnectionTypes elementMap\r
+  \r
+  targetDiagrams = map f sourceDiagrams :: [Diagram]\r
+    where \r
+      f sourceDiagram = fromJust \r
+                      $ getTargetDiagram targetModel \r
+                      $ sourceDiagram\r
+  \r
+  for targetDiagrams $ \diagram ->\r
+    syncActivateOnce $ toResource diagram\r
+    \r
+  doElementPostProcessing elementMap elementPostProcessing\r
+\r
+translateDiagram (sourceModel :: Model)\r
+                 (targetModel :: Model)\r
+                 (folderType :: Resource) \r
+                 (compositeType :: Resource)\r
+                 (f :: Diagram -> <ReadGraph> [(DiagramElement Resource,Resource)])\r
+                 (joinMap :: Dynamic -> <WriteGraph> Resource)\r
+                 (elementMap :: Map.T (DiagramElement Resource) (Resource,Resource))\r
+                 (diagramPostProcessing :: Diagram -> Diagram -> <Proc,ReadGraph,WriteGraph> ()) \r
+                 (sourceDiagram :: Diagram) = do\r
+  disableDependencies \r
+  targetDiagram = translateDiagram2 targetModel sourceDiagram folderType compositeType f joinMap elementMap\r
+  targetDiagram' = diagramResourceOf targetDiagram\r
+  denyByPredicate targetDiagram' TMPL.HasDrawingTemplate\r
+  execJust (possibleDrawingTemplate targetModel sourceDiagram) (\template -> claim targetDiagram' TMPL.HasDrawingTemplate template)\r
+  diagramPostProcessing sourceDiagram targetDiagram\r
+  ()\r
+\r
+possibleDrawingTemplate :: Model -> Diagram -> <ReadGraph> Maybe Resource\r
+possibleDrawingTemplate model d = do\r
+    d' = diagramResourceOf d\r
+    library = fromJust $ possibleResourceChild (toResource model) "Diagram Templates"\r
+    match (possibleObject d' TMPL.HasDrawingTemplate) with\r
+        Just dt -> match (possibleNameOf dt) with\r
+            Just name -> possibleResourceChild library name\r
+            _ -> Nothing\r
+        _ -> Nothing\r
+\r
+compositeOf :: Resource -> <ReadGraph> Resource\r
+compositeOf d = singleObject d MOD.DiagramToComposite \r
+\r
+diagramOf :: Resource -> <ReadGraph> Resource\r
+diagramOf d = singleObject d MOD.CompositeToDiagram \r
+\r
+makeSpec :: Model -> Diagram -> Resource -> Resource -> <WriteGraph, ReadGraph> DiagramSpec \r
+makeSpec targetModel sourceDiagram folderType compositeType = \r
+  match (getTargetDiagram targetModel sourceDiagram) with\r
+    Just targetDiagram -> ExistingDiagram targetDiagram\r
+    Nothing -> NewDiagram targetModel (pathOf sourceDiagram) folderType compositeType\r
+\r
+getTargetDiagram (targetModel :: Model) (sourceDiagram :: Diagram) =\r
+    (possibleDiagram targetModel $ pathOf sourceDiagram) :: Maybe Diagram\r
+\r
+store :: Map.T (DiagramElement Resource) (Resource,Resource) -> (DiagramElement Resource) -> Resource -> Resource -> <Proc,WriteGraph,ReadGraph> ()\r
+store elementMap a b c = do\r
+  Map.put elementMap a (b,c)\r
+  ()\r
+\r
+getTargetComponent (targetDiagram :: Diagram) (sourceComponent :: Resource) =\r
+    (possibleResourceChild (toResource targetDiagram) (fromJust $ possibleNameOf sourceComponent)) :: Maybe Resource\r
+\r
+translateDiagram2 (targetModel :: Model)  \r
+                  (sourceDiagram :: Diagram) \r
+                  (folderType :: Resource)\r
+                  (compositeType :: Resource)\r
+                  (f :: Diagram -> <ReadGraph> [(DiagramElement Resource,Resource)]) \r
+                  (joinMap :: Dynamic -> <WriteGraph> Resource)\r
+                  (elementMap ::  Map.T (DiagramElement Resource) (Resource,Resource)) = do\r
+  spec = makeSpec targetModel sourceDiagram folderType compositeType\r
+  elementSpecs = f sourceDiagram\r
+  in1 = (filter (not . isReferring) elementSpecs + filter isReferring elementSpecs)\r
+    where\r
+      isReferring ((Connection _ _ _),_) = True\r
+      isReferring ((Monitor _ _ _ _),_) = True\r
+      isReferring _ = False\r
+  in2 = map (\(a,b)->a) in1\r
+  (diagram, elements) = createDiagramR spec joinMap in2 \r
+  iter (\((a,b),c) -> store elementMap a b c) (zip in1 elements)\r
+  diagram :: Diagram
\ No newline at end of file