feat: rendering for node inputs!

public/styles/index.scss

@@ -17,7 +17,7 @@
 
 // Prevent default select behavior on images and icons
 img,
-.material-icons {
+.material-icons, .unselectable {
   user-select: none;
 }
 

src/Capability/Editor/Node/NodeInput.purs

@@ -16,10 +16,10 @@ import Data.Maybe (Maybe)
 import Data.Tuple (Tuple(..), fst)
 import Lunarbox.Data.Duplet (Duplet(..))
 import Lunarbox.Data.List (chunk)
-import Math (tau)
+import Math (Radians, tau)
 
 data Arc a
-  = Arc Number Number a
+  = Arc Radians Radians a
 
 derive instance eqArc :: Eq a => Eq (Arc a)
 

src/Component/Editor/Add.purs

@@ -25,7 +25,7 @@ import Lunarbox.Component.Editor.Node as NodeC
 import Lunarbox.Component.Icon (icon)
 import Lunarbox.Component.Utils (className, container)
 import Lunarbox.Config (Config)
-import Lunarbox.Data.Editor.Constants (nodeRadius)
+import Lunarbox.Data.Editor.Constants (arcWidth, nodeRadius)
 import Lunarbox.Data.Editor.FunctionData (FunctionData)
 import Lunarbox.Data.Editor.FunctionName (FunctionName)
 import Lunarbox.Data.Editor.Node (Node(..))
@@ -98,7 +98,7 @@ component =
       [ SE.svg
           [ SA.width 75.0
           , SA.height 75.0
-          , SA.viewBox (-nodeRadius) (-nodeRadius) (nodeRadius * 2.0) (nodeRadius * 2.0)
+          , let size = arcWidth + nodeRadius in SA.viewBox (-size) (-size) (2.0 * size) (2.0 * size)
           ]
           [ slot
               (SProxy :: _ "node")

src/Component/Editor/Node.purs

@@ -8,9 +8,12 @@ module Lunarbox.Component.Editor.Node
 
 import Prelude
 import Data.Array (catMaybes, mapWithIndex)
+import Data.Array (toUnfoldable) as Array
 import Data.Int (toNumber)
 import Data.Lens (Lens', over, set, view)
 import Data.Lens.Record (prop)
+import Data.List (List(..))
+import Data.List as List
 import Data.Maybe (Maybe(..))
 import Data.Symbol (SProxy(..))
 import Data.Typelevel.Num (d0, d1)
@@ -20,13 +23,14 @@ import Halogen (Component, HalogenM, defaultEval, gets, mkComponent, mkEval, mod
 import Halogen.HTML (HTML)
 import Halogen.HTML as HH
 import Halogen.HTML.Events (onMouseDown)
-import Lunarbox.Data.Editor.Constants (nodeRadius)
-import Lunarbox.Data.Editor.FunctionData (FunctionData)
+import Lunarbox.Capability.Editor.Node.NodeInput (Arc(..), fillWith)
+import Lunarbox.Data.Editor.Constants (arcSpacing, arcWidth, nodeRadius)
+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 (strokeWidth)
-import Svg.Attributes (TextAnchor(..))
+import Lunarbox.Svg.Attributes (arc, strokeWidth, transparent)
+import Svg.Attributes (D(..), TextAnchor(..))
 import Svg.Attributes as SA
 import Svg.Elements as SE
 
@@ -86,6 +90,15 @@ output true =
     , SA.fill $ Just $ SA.RGB 118 255 0
     ]
 
+displayArc :: forall r. Number -> Arc String -> HTML r Action
+displayArc radius (Arc start end _) =
+  SE.path
+    [ SA.d $ Abs <$> arc radius (start + arcSpacing) (end - arcSpacing)
+    , SA.fill $ Just transparent
+    , SA.stroke $ Just $ SA.RGB 63 196 255
+    , strokeWidth arcWidth
+    ]
+
 component :: forall m. MonadEffect m => Component HH.HTML Query Input Output m
 component =
   mkComponent
@@ -127,7 +140,7 @@ component =
 
   overlays :: Array (Maybe (HTML _ Action)) -> HTML _ Action
   overlays =
-    SE.g []
+    SE.g [ SA.class_ "unselectable" ]
       <<< mapWithIndex
           ( \index elem ->
               SE.g
@@ -148,22 +161,23 @@ component =
 
   render { selectable
   , nodeData: NodeData { position, selected }
+  , functionData
   , labels
   , hasOutput
   } =
-    SE.g
-      [ SA.transform
-          [ SA.Translate (position !! d0) (position !! d1) ]
-      , onMouseDown $ const $ if selectable then Just $ SetSelection true else Nothing
-      ]
-      [ SE.circle
-          [ SA.r nodeRadius
-          , SA.fill $ Just $ SA.RGBA 0 0 0 0.0
-          , SA.stroke $ Just $ if (selected && selectable) then SA.RGB 118 255 2 else SA.RGB 63 196 255
-          , strokeWidth 5.0
-          ]
-      , overlays
-          $ (label <$> _)
-          <$> labels
-      , output hasOutput
-      ]
+    let
+      inputs = Array.toUnfoldable $ _.name <$> view _FunctionDataInputs functionData
+
+      inputArcs = fillWith inputs Nil
+    in
+      SE.g
+        [ SA.transform
+            [ SA.Translate (position !! d0) (position !! d1) ]
+        , onMouseDown $ const $ if selectable then Just $ SetSelection true else Nothing
+        ]
+        [ overlays
+            $ (label <$> _)
+            <$> labels
+        , output hasOutput
+        , SE.g [ SA.transform [ SA.Rotate 90.0 0.0 0.0 ] ] $ displayArc nodeRadius <$> (List.toUnfoldable inputArcs)
+        ]

src/Control/Monad/Dataflow/Infer/InferExpression.purs

@@ -105,5 +105,5 @@ infer expression =
       Literal _ LNull -> fresh
       Literal _ (LInt _) -> pure typeNumber
       Literal _ (LBool _) -> pure typeBool
-      Native _ (NativeExpression t _) -> pure t
+      Native _ (NativeExpression scheme _) -> instantiate scheme
     rememberType type'

src/Data/Dataflow/Expression.purs

@@ -21,7 +21,7 @@ import Data.Maybe (Maybe)
 import Data.Newtype (class Newtype, unwrap)
 import Data.Set (Set)
 import Lunarbox.Data.Dataflow.Runtime (RuntimeValue)
-import Lunarbox.Data.Dataflow.Type (Type)
+import Lunarbox.Data.Dataflow.Scheme (Scheme)
 
 newtype VarName
   = VarName String
@@ -48,7 +48,7 @@ instance showLiteral :: Show Literal where
   show LNull = "null"
 
 data NativeExpression
-  = NativeExpression Type RuntimeValue
+  = NativeExpression Scheme RuntimeValue
 
 derive instance eqNativeExpression :: Eq NativeExpression
 

src/Data/Dataflow/Native/ControlFlow.purs

@@ -0,0 +1,32 @@
+module Lunarbox.Data.Dataflow.Native.ControlFlow
+  ( if'
+  ) where
+
+import Lunarbox.Data.Dataflow.Expression (NativeExpression(..))
+import Lunarbox.Data.Dataflow.Native.NativeConfig (NativeConfig(..))
+import Lunarbox.Data.Dataflow.Runtime (RuntimeValue(..), binaryFunction)
+import Lunarbox.Data.Dataflow.Scheme (Scheme(..))
+import Lunarbox.Data.Dataflow.Type (TVarName(..), Type(..), typeBool)
+import Lunarbox.Data.Editor.FunctionData (FunctionData, internal)
+import Lunarbox.Data.Editor.FunctionName (FunctionName(..))
+import Prelude (const, flip, ($))
+
+typeIf :: Scheme
+typeIf = Forall [ return ] $ TArrow typeBool $ TArrow typeReturn typeReturn
+  where
+  return = TVarName "a"
+
+  typeReturn = TVarariable return
+
+evalIf :: RuntimeValue -> RuntimeValue
+evalIf (Bool true) = binaryFunction const
+
+evalIf _ = binaryFunction $ flip const
+
+if' :: NativeConfig FunctionData
+if' =
+  NativeConfig
+    { name: FunctionName "if"
+    , expression: (NativeExpression typeIf $ Function evalIf)
+    , functionData: internal [ { name: "condition" }, { name: "then" }, { name: "else" } ]
+    }

src/Data/Dataflow/Native/Math.purs

@@ -5,6 +5,7 @@ module Lunarbox.Data.Dataflow.Native.Math
 import Lunarbox.Data.Dataflow.Expression (NativeExpression(..))
 import Lunarbox.Data.Dataflow.Native.NativeConfig (NativeConfig(..))
 import Lunarbox.Data.Dataflow.Runtime (RuntimeValue(..), binaryFunction)
+import Lunarbox.Data.Dataflow.Scheme (Scheme(..))
 import Lunarbox.Data.Dataflow.Type (Type(..), typeNumber)
 import Lunarbox.Data.Editor.FunctionData (FunctionData, internal)
 import Lunarbox.Data.Editor.FunctionName (FunctionName(..))
@@ -22,7 +23,6 @@ add :: NativeConfig FunctionData
 add =
   NativeConfig
     { name: FunctionName "add"
-    , expression: (NativeExpression addT $ binaryFunction addRuntimeValue)
+    , expression: (NativeExpression (Forall [] addT) $ binaryFunction addRuntimeValue)
     , functionData: internal [ { name: "a" }, { name: "b" } ]
-    , inputs: 2
     }

src/Data/Dataflow/Native/NativeConfig.purs

@@ -15,7 +15,6 @@ newtype NativeConfig f
   { functionData :: f
   , expression :: NativeExpression
   , name :: FunctionName
-  , inputs :: Int
   }
 
 loadNativeConfig :: forall f n. NativeConfig f -> Project f n -> Project f n

src/Data/Dataflow/Native/Prelude.purs

@@ -3,13 +3,14 @@ module Lunarbox.Data.Dataflow.Native.Prelude
   , loadPrelude
   ) where
 
+import Lunarbox.Data.Dataflow.Native.ControlFlow (if')
 import Lunarbox.Data.Dataflow.Native.Math (add)
 import Lunarbox.Data.Dataflow.Native.NativeConfig (NativeConfig, loadNativeConfigs)
 import Lunarbox.Data.Editor.FunctionData (FunctionData)
 import Lunarbox.Data.Editor.Project (Project)
 
 configs :: Array (NativeConfig FunctionData)
-configs = [ add ]
+configs = [ add, if' ]
 
 loadPrelude :: forall n. Project FunctionData n -> Project FunctionData n
 loadPrelude = loadNativeConfigs configs

src/Data/Dataflow/Runtime.purs

@@ -13,6 +13,7 @@ import Data.Maybe (Maybe(..))
 data RuntimeValue
   = Number Number
   | String String
+  | Bool Boolean
   | Null
   | Function (RuntimeValue -> RuntimeValue)
 

src/Data/Dataflow/Scheme.purs

@@ -7,6 +7,8 @@ import Lunarbox.Data.Dataflow.Type (TVarName(..), Type)
 data Scheme
   = Forall (Array TVarName) Type
 
+derive instance eqScheme :: Eq Scheme
+
 instance showScheme :: Show Scheme where
   show (Forall [] t) = show t
   show (Forall quantifiers t) = "forall" <> fold (quantifiers <#> (\(TVarName n) -> " " <> n)) <> ". " <> show t

src/Data/Editor/Constants.purs

@@ -1,5 +1,19 @@
-module Lunarbox.Data.Editor.Constants (nodeRadius) where
+module Lunarbox.Data.Editor.Constants
+  ( nodeRadius
+  , arcSpacing
+  , arcWidth
+  ) where
+
+import Math (Radians)
 
 -- visual radius for nodes
 nodeRadius :: Number
 nodeRadius = 50.0
+
+-- How much spage to display between node inputs
+arcSpacing :: Radians
+arcSpacing = 0.1
+
+-- What width should the stroke of node inputs have
+arcWidth :: Number
+arcWidth = 5.0

src/Data/Editor/FunctionData.purs

@@ -3,6 +3,7 @@ module Lunarbox.Data.Editor.FunctionData
   , getFunctionData
   , internal
   , _FunctionDataExternal
+  , _FunctionDataInputs
   ) where
 
 import Prelude

src/Svg/Attributes.purs

@@ -1,10 +1,44 @@
-module Lunarbox.Svg.Attributes where
+module Lunarbox.Svg.Attributes
+  ( strokeWidth
+  , arc
+  , transparent
+  ) where
 
+import Prelude
+import Data.Typelevel.Num (d0, d1)
+import Data.Vec (vec2, (!!))
 import Halogen.HTML (IProp)
+import Lunarbox.Capability.Editor.Node.NodeInput (Arc(..), length)
+import Lunarbox.Data.Vector (Vec2)
+import Math (Radians, cos, pi, sin)
+import Svg.Attributes (Color(..), Command(..))
 import Svg.Attributes as SA
 import Unsafe.Coerce (unsafeCoerce)
 
 -- There's a bug with halogen-svg which doen's allow me to use this 
 -- so I made a wrapper which allows me anywhere where I can use a stroke 
 strokeWidth :: forall r i. Number -> IProp ( stroke :: String | r ) i
 strokeWidth = unsafeCoerce SA.strokeWidth
+
+polarToCartesian :: Number -> Radians -> Vec2 Number
+polarToCartesian radius angle = (radius * _) <$> vec2 (cos angle) (sin angle)
+
+arcLength :: Radians -> Radians -> Radians
+arcLength start end = length $ Arc start end unit
+
+-- The A command for svg is pretty hard to use. 
+-- This is a wrapper which allows using it for circle arcs
+arc :: Number -> Radians -> Radians -> Array Command
+arc radius startAngle endAngle =
+  let
+    start = polarToCartesian radius endAngle
+
+    end = polarToCartesian radius startAngle
+
+    largeArcFlag = not $ arcLength startAngle endAngle >= pi
+  in
+    [ M (start !! d0) $ start !! d1, A radius radius 0.0 largeArcFlag true (end !! d0) (end !! d1) ]
+
+-- Transparent color
+transparent :: Color
+transparent = RGBA 0 0 0 0.0