module JSPlumbdemo import iTasks, Tasklet import Text.StringAppender, graph_to_sapl_string import sapldebug Start :: *World -> *World Start world = startEngine (workAs (AuthenticatedUser "root" [] Nothing) (manageWorklist taskletExamples)) world taskletExamples :: [Workflow] taskletExamples = [workflow "JSPlumb tasklet" "Simple JSPlumb tasklet" plumbtasklet] plumbtasklet :: Task Void plumbtasklet = mkInstanceId >>= \iid -> mkTask (iid, jsPlumbTasklet) targetOptions = {mkEndpoint & anchor = Just [toHtmlObject "TopCenter"] , maxConnections = Just -1 , isTarget = Just True , endpoint = Just [toHtmlObject "Dot",toHtmlObject {radius = 5}] , paintStyle = Just {fillStyle = "#66CC00"} } sourceOptions = {mkEndpoint & anchor = Just [toHtmlObject "BottomCenter"] , maxConnections = Just -1 , isSource = Just True , endpoint = Just [toHtmlObject "Dot",toHtmlObject {radius = 5}] , paintStyle = Just {fillStyle = "#EEDD00"} } :: EndPointOptions = { anchor :: Maybe [HtmlObject] , endpoint :: Maybe [HtmlObject] , enabled :: Maybe Bool , paintStyle :: Maybe FillStyle , hoverPaintStyle :: Maybe FillStyle , cssClass :: Maybe String , hoverClas :: Maybe String , source :: Maybe String , canvas :: Maybe HtmlObject , container :: Maybe String , connections :: Maybe [HtmlObject] , isSource :: Maybe Bool , maxConnections :: Maybe Int , dragOptions :: Maybe HtmlObject , connectorStyle :: Maybe FillStyle , connectorHoverStyle :: Maybe FillStyle , connector :: Maybe [HtmlObject] , connectorOverlays :: Maybe [HtmlObject] , connectorClass :: Maybe String , connectorHoverClass :: Maybe String , connectionDetachable :: Maybe Bool , isTarget :: Maybe Bool , dropOptions :: Maybe HtmlObject , reattach :: Maybe Bool , parameters :: Maybe HtmlObject } mkEndpoint :: EndPointOptions mkEndpoint = { anchor = Nothing , endpoint = Nothing , enabled = Nothing , paintStyle = Nothing , hoverPaintStyle = Nothing , cssClass = Nothing , hoverClas = Nothing , source = Nothing , canvas = Nothing , container = Nothing , connections = Nothing , isSource = Nothing , maxConnections = Nothing , dragOptions = Nothing , connectorStyle = Nothing , connectorHoverStyle = Nothing , connector = Nothing , connectorOverlays = Nothing , connectorClass = Nothing , connectorHoverClass = Nothing , connectionDetachable = Nothing , isTarget = Nothing , dropOptions = Nothing , reattach = Nothing , parameters = Nothing } :: Radius = {radius :: Int} :: FillStyle = {fillStyle :: String} :: PlumbState = {plumb :: Maybe HtmlObject} jsPlumbTasklet :: Tasklet PlumbState Void jsPlumbTasklet = { generatorFunc = jsPlumbGUI , resultFunc = \_ -> Value Void False , tweakUI = setTitle "JSPlumb Tasklet" } where jsPlumbGUI iid taskId Nothing iworld = jsPlumbGUI iid taskId (Just {plumb = Nothing}) iworld jsPlumbGUI iid _ (Just st) iworld # canvas = DivTag [IdAttr "plumb_canvas", StyleAttr "width:100%; height:100%"] [] # gui = { TaskletHTML | width = ExactSize 600 , height = ExactSize 600 , html = HtmlDef (html canvas) , eventHandlers = [HtmlEvent "tasklet" "init" onInit ,HtmlEvent "tasklet" "destroy" onDestroy ,HtmlEvent "tasklet" "afterlayout" onAfterLayout] } = (TaskletHTML gui, st, iworld) where onScriptLoad st _ _ d # (d, _) = setDomAttr d "plumb_canvas" "innerHTML" ("