From 77ca8d7f484a3dfa3c4fec8a55b49123812213e0 Mon Sep 17 00:00:00 2001 From: Matei Adriel Date: Tue, 14 Apr 2020 12:22:16 +0300 Subject: [PATCH] feat: dotted lines --- src/Component/Editor.purs | 6 +++--- src/Component/Editor/Add.purs | 3 +-- src/Component/Editor/Node.purs | 32 ++++++++++++++++++++++++++----- src/Data/Dataflow/Expression.purs | 6 ++++++ src/Data/Editor/FunctionData.purs | 7 ++++++- src/Svg/Attributes.purs | 26 ++++++++++++++++++++++++- 6 files changed, 68 insertions(+), 12 deletions(-) diff --git a/src/Component/Editor.purs b/src/Component/Editor.purs index eedbb5f..363956d 100644 --- a/src/Component/Editor.purs +++ b/src/Component/Editor.purs @@ -30,9 +30,9 @@ import Lunarbox.Component.Icon (icon) import Lunarbox.Component.Utils (container) import Lunarbox.Config (Config) import Lunarbox.Control.Monad.Dataflow.Solve.SolveExpression (printTypeMap, solveExpression) -import Lunarbox.Control.Monad.Effect (print, printString) +import Lunarbox.Control.Monad.Effect (printString) import Lunarbox.Data.Dataflow.Class.Expressible (nullExpr) -import Lunarbox.Data.Dataflow.Expression (Expression) +import Lunarbox.Data.Dataflow.Expression (Expression, printSource) import Lunarbox.Data.Dataflow.Native.Prelude (loadPrelude) import Lunarbox.Data.Dataflow.Type (Type, numberOfInputs) import Lunarbox.Data.Editor.DataflowFunction (DataflowFunction) @@ -168,7 +168,7 @@ component = Right map -> map Left _ -> mempty printString $ printTypeMap typeMap - print expression' + printString $ printSource expression' -- TODO: make it so this accounts for errors modify_ $ Record.merge { expression: expression', typeMap } UpdateNodeGroup group -> do diff --git a/src/Component/Editor/Add.purs b/src/Component/Editor/Add.purs index 9c2e469..9b30cef 100644 --- a/src/Component/Editor/Add.purs +++ b/src/Component/Editor/Add.purs @@ -123,8 +123,7 @@ component = [ HP.classes $ ClassName <$> ("active" <$ guard isEditable) , onClick $ const $ guard isEditable $> SelectFunction name ] - [ icon "edit" - ] + [ icon "edit" ] ] ] ] diff --git a/src/Component/Editor/Node.purs b/src/Component/Editor/Node.purs index f2ab67a..8ba16e0 100644 --- a/src/Component/Editor/Node.purs +++ b/src/Component/Editor/Node.purs @@ -7,6 +7,7 @@ module Lunarbox.Component.Editor.Node ) where import Prelude + import Data.Array (catMaybes, mapWithIndex) import Data.Array (toUnfoldable) as Array import Data.Int (toNumber) @@ -29,7 +30,7 @@ import Lunarbox.Data.Editor.FunctionData (FunctionData, _FunctionDataInputs) import Lunarbox.Data.Editor.Node (Node) import Lunarbox.Data.Editor.Node.NodeData (NodeData(..), _NodeDataPosition, _NodeDataSelected, _NodeDataZPosition) import Lunarbox.Data.Vector (Vec2) -import Lunarbox.Svg.Attributes (arc, strokeWidth, transparent) +import Lunarbox.Svg.Attributes (Linecap(..), arc, strokeDashArray, strokeLinecap, strokeWidth, transparent) import Svg.Attributes (D(..), TextAnchor(..)) import Svg.Attributes as SA import Svg.Elements as SE @@ -90,13 +91,27 @@ output true = , SA.fill $ Just $ SA.RGB 118 255 0 ] -displayArc :: forall r. Number -> Arc String -> HTML r Action -displayArc radius (Arc start end _) = +displayArc :: forall r. Number -> Number -> Arc String -> HTML r Action +displayArc spacing radius (Arc start end _) = SE.path - [ SA.d $ Abs <$> arc radius (start + arcSpacing) (end - arcSpacing) + [ SA.d $ Abs <$> arc radius (start + spacing) (end - spacing) , SA.fill $ Just transparent , SA.stroke $ Just $ SA.RGB 63 196 255 , strokeWidth arcWidth + , + + strokeLinecap Round + ] + +constant :: forall r. HTML r Action +constant = + SE.circle + [ SA.r nodeRadius + , SA.fill $ Just transparent + , SA.stroke $ Just $ SA.RGB 176 112 107 + , strokeWidth arcWidth, + strokeLinecap Round + , strokeDashArray [ 5.0 ] ] component :: forall m. MonadEffect m => Component HH.HTML Query Input Output m @@ -179,5 +194,12 @@ component = $ (label <$> _) <$> labels , output hasOutput - , SE.g [ SA.transform [ SA.Rotate 90.0 0.0 0.0 ] ] $ displayArc nodeRadius <$> (List.toUnfoldable inputArcs) + , if List.null inputArcs then + constant + else + SE.g + [ SA.transform [ SA.Rotate 90.0 0.0 0.0 ] + ] + $ displayArc (if List.length inputArcs == 1 then 0.0 else arcSpacing) nodeRadius + <$> (List.toUnfoldable inputArcs) ] diff --git a/src/Data/Dataflow/Expression.purs b/src/Data/Dataflow/Expression.purs index 0f292ae..28c30e2 100644 --- a/src/Data/Dataflow/Expression.purs +++ b/src/Data/Dataflow/Expression.purs @@ -9,6 +9,8 @@ module Lunarbox.Data.Dataflow.Expression , locations , lookup , printExpressionAt + , printRawExpression + , printSource , sumarizeExpression , inputs , wrap @@ -155,6 +157,10 @@ printRawExpression print = case _ of Chain l (e : es) -> "{" <> printRawExpression print e <> "," <> (printRawExpression print $ Chain l es) <> "}" Chain _ Nil -> "" +-- Print an expression without the locations +printSource :: forall l. Show l => Expression l -> String +printSource = printRawExpression (\e -> printSource e) + -- Wrap an expression in another expression with a custom location wrap :: forall l. l -> Expression l -> Expression l wrap location = Chain location <<< pure diff --git a/src/Data/Editor/FunctionData.purs b/src/Data/Editor/FunctionData.purs index 8d071e6..a12346b 100644 --- a/src/Data/Editor/FunctionData.purs +++ b/src/Data/Editor/FunctionData.purs @@ -2,6 +2,7 @@ module Lunarbox.Data.Editor.FunctionData ( FunctionData(..) , getFunctionData , internal + , outputData , _FunctionDataExternal , _FunctionDataInputs ) where @@ -34,11 +35,15 @@ instance defaultFunctionData :: Default FunctionData where } -- Helpers +-- Function data for output nodes +outputData :: FunctionData +outputData = internal [ { name: "return value" } ] + getFunctionData :: (FunctionName -> FunctionData) -> Node -> FunctionData getFunctionData getter = case _ of ComplexNode { function } -> getter function -- TODO: find a good way to handle this - OutputNode _ -> def + OutputNode _ -> outputData InputNode -> def -- Create data for an internal function diff --git a/src/Svg/Attributes.purs b/src/Svg/Attributes.purs index cd0222d..e57c5a5 100644 --- a/src/Svg/Attributes.purs +++ b/src/Svg/Attributes.purs @@ -3,12 +3,17 @@ module Lunarbox.Svg.Attributes , arc , chord , transparent + , strokeDashArray, + strokeLinecap, + Linecap(..) ) where import Prelude +import Core (attr) +import Data.String (joinWith) import Data.Typelevel.Num (d0, d1) import Data.Vec (vec2, (!!)) -import Halogen.HTML (IProp) +import Halogen.HTML (AttrName(..), IProp) import Lunarbox.Capability.Editor.Node.NodeInput (Arc(..), length) import Lunarbox.Data.Vector (Vec2) import Math (Radians, cos, pi, sin) @@ -21,6 +26,25 @@ import Unsafe.Coerce (unsafeCoerce) strokeWidth :: forall r i. Number -> IProp ( stroke :: String | r ) i strokeWidth = unsafeCoerce SA.strokeWidth +-- The halogen-svg lib doesn't support this so I had to make my own +strokeDashArray :: forall r i. Array Number -> IProp ( stroke :: String | r ) i +strokeDashArray = unsafeCoerce $ attr (AttrName "stroke-dasharray") <<< joinWith "," + +-- stroke linecaps for svg +data Linecap + = Butt + | Round + | Square + +instance showLinecap :: Show Linecap where + show Butt = "butt" + show Round = "round" + show Square = "square" + +-- Same reason I have this as strokeDashArray +strokeLinecap :: forall r i. Linecap -> IProp ( stroke :: String | r ) i +strokeLinecap = unsafeCoerce <<< attr (AttrName "stroke-linecap") <<< show + polarToCartesian :: Number -> Radians -> Vec2 Number polarToCartesian radius angle = (radius * _) <$> vec2 (cos angle) (sin angle)