X-Git-Url: https://gerrit.simantics.org/r/gitweb?p=simantics%2Fplatform.git;a=blobdiff_plain;f=bundles%2Forg.simantics.modeling%2Fscl%2FSimantics%2FUserComponent.scl;h=ad62e1d6a3effcae29504af0ddab77c399cef685;hp=0eaff183ae965bcc29f79fbdb9b1372fb354583b;hb=c26409b1caf2f1e560d37c5befd11b442399c3fe;hpb=969bd23cab98a79ca9101af33334000879fb60c5 diff --git a/bundles/org.simantics.modeling/scl/Simantics/UserComponent.scl b/bundles/org.simantics.modeling/scl/Simantics/UserComponent.scl index 0eaff183a..ad62e1d6a 100644 --- a/bundles/org.simantics.modeling/scl/Simantics/UserComponent.scl +++ b/bundles/org.simantics.modeling/scl/Simantics/UserComponent.scl @@ -1,135 +1,161 @@ -include "Simantics/Model" -import "Simantics/Diagram" -import "Simantics/Flag" -include "Simantics/Ontologies" - -type UserComponent = Resource -type ComponentTypeConfiguration = Resource -type ComponentTypeProperty = Resource - -importJava "org.simantics.modeling.NewComponentType" where - @JavaName createComponentType - createUserComponent :: Model -> UserComponent - -configurationOfComponentType :: UserComponent -> Resource -configurationOfComponentType component = do - config = singleObject (toResource component) STR.IsDefinedBy - config - -importJava "org.simantics.modeling.flags.LiftFlag" where - liftFlag :: Resource -> Maybe String - -flagToTerminal :: Flag -> Resource -flagToTerminal flag = do - result = liftFlag (toResource flag) - if result == Nothing - then singleObject (toResource flag) DIA.IsLiftedAs - else do - show result - (toResource flag) - -configToDiagram :: Resource -> Diagram -configToDiagram config = do - fromResource config - -populateTerminalToSymbol :: Resource -> (Double, Double) -> Element -populateTerminalToSymbol terminal (x, y) = do - uc = singleObject terminal L0.PartOf - symbol = singleObject uc MOD.ComponentTypeToSymbol - diagram = singleObject symbol STR.IsDefinedBy - element = newResource () - addToOrderedSet diagram element - claim diagram - L0.ConsistsOf - element - elementClass = singleObject terminal MOD.ConnectionRelationToTerminal - claim element - L0.InstanceOf - elementClass - s = ((match possibleRelatedValue diagram DIA.HasModCount with Nothing -> 1 ; Just v -> v) :: Long) - claimRelatedValue element - L0.HasName - (show s) - claimRelatedValue diagram - DIA.HasModCount - ((match possibleRelatedValue diagram DIA.HasModCount with Nothing -> 1 ; Just v -> v+1) :: Long) - claimRelatedValueWithType element - DIA.HasTransform - G2D.Transform - (toDoubleArray [1,0,0,1,x,y]) - addToGraph diagram terminal element - addCommentMetadata ("Populated terminal " + (show element) + " to user component " + (show uc)) - (fromResource element) - -importJava "org.simantics.modeling.symbolEditor.PopulateTerminal" where - addToGraph :: Resource -> Resource -> Resource -> () - -importJava "org.simantics.modeling.NewSymbolGroupRequest" where - createNewSymbolGroup :: Model -> String -> Resource - -importJava "org.simantics.modeling.AssignSymbolGroupRequest" where - assignSymbolGroup :: [Resource] -> [Resource] -> [UserComponent] -> () - -importJava "org.simantics.modeling.GetSymbolGroups" where - getSymbolGroups :: Resource -> [Resource] - -importJava "org.simantics.modeling.userComponent.ComponentTypeCommands" where - @JavaName createPropertyWithDefaults - createUserComponentProperty :: UserComponent -> Resource - - @JavaName rename - renameUserComponentProperty :: Resource -> String -> () - - @JavaName setDescription - setUserComponentPropertyDescription :: Resource -> String -> () - - @JavaName createMonitorPropertyWithDefaults - createUserComponentMonitorProperty :: UserComponent -> Resource - - setMonitorExpression :: Resource -> Resource -> String -> () - - @JavaName setDefaultValue - setUserComponentPropertyDefaultValue :: Resource -> Resource -> String -> () - - @JavaName setUnit - setUserComponentPropertyUnit :: Resource -> Resource -> String -> () - - @JavaName setRange - setUserComponentPropertyRange :: Resource -> Resource -> String -> () - - @JavaName setLabel - setUserComponentPropertyLabel :: Resource -> String -> () - - @private - editType :: Resource -> Resource -> Boolean -> String -> () - -setUserComponentPropertyRequiredType :: Resource -> Resource -> String -> () -setUserComponentPropertyRequiredType componentType property newValue = do - editType componentType property True newValue - -importJava "org.simantics.modeling.UserComponentMigration" where - migrateUserComponents :: UserComponent -> UserComponent -> [Component] -> () - - -/* - @JavaName newAnnotationProperty - createProperty :: UserComponent -> ComponentTypeProperty - - @JavaName advancedAnnotationProperty - createAdvancedProperty :: UserComponent -> String -> String -> String -> String -> String -> String -> ComponentTypeProperty - - @JavaName removeAnnotationProperty - removeProperty :: UserComponent -> ComponentTypeProperty -> () -*/ - -""" -`addUserComponentScript userComponent scriptType scriptCode` adds the script to the user component. -""" -addUserComponentScript :: Resource -> String -> String -> String -> () -addUserComponentScript userComponent scriptName scriptType scriptCode = do - script = newResource () - claim script L0.InstanceOf STR.ComponentTypeScript - claim userComponent STR.ComponentType.hasScript script - claimRelatedValue script L0.HasName scriptName - claimRelatedValue script STR.ComponentTypeScript.type scriptType - claimRelatedValue script STR.ComponentTypeScript.code scriptCode +include "Simantics/Model" +import "Simantics/Diagram" +import "Simantics/Flag" +import "Simantics/Workbench" +include "Simantics/Ontologies" + +type UserComponent = Resource +type ComponentTypeConfiguration = Resource +type ComponentTypeProperty = Resource + +importJava "org.simantics.modeling.NewComponentType" where + @JavaName createComponentType + createUserComponent :: Model -> UserComponent + +configurationOfComponentType :: UserComponent -> Resource +configurationOfComponentType component = do + config = singleObject component STR.IsDefinedBy + config + +importJava "org.simantics.modeling.flags.LiftFlag" where + liftFlag :: Resource -> Maybe String + +flagToTerminal :: Flag -> Resource +flagToTerminal flag = do + result = liftFlag flag + if result == Nothing + then singleObject flag DIA.IsLiftedAs + else flag + +@deprecated "Calling this function is unnecessary." +configToDiagram :: Resource -> Diagram +configToDiagram config = config + +populateTerminalToSymbol :: Resource -> (Double, Double) -> Element +populateTerminalToSymbol terminal (x, y) = element + where + uc = singleObject terminal L0.PartOf + symbol = singleObject uc MOD.ComponentTypeToSymbol + diagram = singleObject symbol STR.IsDefinedBy + element = newResource () + addToOrderedSet diagram element + claim diagram + L0.ConsistsOf + element + elementClass = singleObject terminal MOD.ConnectionRelationToTerminal + claim element + L0.InstanceOf + elementClass + s = ((match possibleRelatedValue diagram DIA.HasModCount with Nothing -> 1 ; Just v -> v) :: Long) + claimRelatedValue element + L0.HasName + (show s) + claimRelatedValue diagram + DIA.HasModCount + ((match possibleRelatedValue diagram DIA.HasModCount with Nothing -> 1 ; Just v -> v+1) :: Long) + claimRelatedValueWithType element + DIA.HasTransform + G2D.Transform + (toDoubleArray [1,0,0,1,x,y]) + addToGraph diagram terminal element + addCommentMetadata ("Populated terminal " + (show element) + " to user component " + (show uc)) + + +importJava "org.simantics.modeling.symbolEditor.PopulateTerminal" where + addToGraph :: Resource -> Resource -> Resource -> () + +importJava "org.simantics.modeling.NewSymbolGroupRequest" where + createNewSymbolGroup :: Model -> String -> Resource + +importJava "org.simantics.modeling.AssignSymbolGroupRequest" where + assignSymbolGroup :: [Resource] -> [Resource] -> [UserComponent] -> () + +importJava "org.simantics.modeling.GetSymbolGroups" where + getSymbolGroups :: Resource -> [Resource] + +importJava "org.simantics.modeling.userComponent.ComponentTypeCommands" where + @JavaName createPropertyWithDefaults + createUserComponentProperty :: UserComponent -> Resource + + @JavaName rename + renameUserComponentProperty :: Resource -> String -> () + + @JavaName setDescription + setUserComponentPropertyDescription :: Resource -> String -> () + + @JavaName createMonitorPropertyWithDefaults + createUserComponentMonitorProperty :: UserComponent -> Resource + + setMonitorExpression :: Resource -> Resource -> String -> () + + @JavaName setDefaultValue + setUserComponentPropertyDefaultValue :: Resource -> Resource -> String -> () + + @JavaName setUnit + setUserComponentPropertyUnit :: Resource -> Resource -> String -> () + + @JavaName setRange + setUserComponentPropertyRange :: Resource -> Resource -> String -> () + + @JavaName setLabel + setUserComponentPropertyLabel :: Resource -> String -> () + + @private + editType :: Resource -> Resource -> Boolean -> String -> () + +setUserComponentPropertyRequiredType :: Resource -> Resource -> String -> () +setUserComponentPropertyRequiredType componentType property newValue = do + editType componentType property True newValue + +importJava "org.simantics.modeling.UserComponentMigration" where + migrateUserComponents :: UserComponent -> UserComponent -> [Component] -> () + + +/* + @JavaName newAnnotationProperty + createProperty :: UserComponent -> ComponentTypeProperty + + @JavaName advancedAnnotationProperty + createAdvancedProperty :: UserComponent -> String -> String -> String -> String -> String -> String -> ComponentTypeProperty + + @JavaName removeAnnotationProperty + removeProperty :: UserComponent -> ComponentTypeProperty -> () +*/ + +""" +`addUserComponentScript userComponent scriptType scriptCode` adds the script to the user component. +""" +addUserComponentScript :: Resource -> String -> String -> String -> () +addUserComponentScript userComponent scriptName scriptType scriptCode = do + script = newResource () + claim script L0.InstanceOf STR.ComponentTypeScript + claim userComponent STR.ComponentType.hasScript script + claimRelatedValue script L0.HasName scriptName + claimRelatedValue script STR.ComponentTypeScript.type scriptType + claimRelatedValue script STR.ComponentTypeScript.code scriptCode + +@private +possibleSubstructure :: Resource -> Maybe Resource +possibleSubstructure element = do + match possibleObject element MOD.ElementToComponent with + Nothing -> Nothing + Just component -> match possibleTypeOf component STR.Component with + Nothing -> Nothing + Just componentType -> match possibleObject componentType STR.IsDefinedBy with + Nothing -> Nothing + Just configuration -> Just configuration + +@private +possibleSubstructureEditor :: Resource -> Maybe (Resource,EditorAdapter) +possibleSubstructureEditor element = match possibleSubstructure element with + Nothing -> Nothing + Just configuration -> do + adapters = editorAdapters configuration + if(length adapters > 0) then Just (configuration, adapters!0) else Nothing + +navigateToSubstructureAction :: Resource -> () +navigateToSubstructureAction element = do + match (syncRead (\x -> possibleSubstructureEditor element)) with + Nothing -> () + Just (configuration,editor) -> openEditor editor configuration + \ No newline at end of file