Skip to content
This repository has been archived by the owner on Mar 4, 2024. It is now read-only.

Commit

Permalink
feat: some more coloring stuff
Browse files Browse the repository at this point in the history
  • Loading branch information
prescientmoon committed Apr 16, 2020
1 parent 2fa1169 commit 2ff7081
Show file tree
Hide file tree
Showing 4 changed files with 57 additions and 41 deletions.
2 changes: 1 addition & 1 deletion package.json
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
"scripts": {
"prepare:purescript": "rm -rf output/bundle.js && hygen bundle prepare",
"build:purescript": "spago build",
"dev": "pnpm run prepare:purescript && tsc -w & parcel public/index.html --port 8080 & nodemon",
"dev": "pnpm run prepare:purescript && parcel public/index.html --port 8080 & nodemon",
"prebuild": "rm -rf dist",
"bundle:purescript": "cross-env NODE_ENV=production pnpm run prepare:purescript && spago bundle-app -t output/prod-bundle.js",
"build": "tsc && pnpm run bundle:purescript && parcel build public/index.html",
Expand Down
6 changes: 5 additions & 1 deletion src/Component/Editor/Add.purs
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@ import Data.Array as Array
import Data.Default (def)
import Data.Lens (Lens', view)
import Data.Lens.Record (prop)
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..))
Expand All @@ -32,6 +33,7 @@ import Lunarbox.Data.Editor.FunctionName (FunctionName)
import Lunarbox.Data.Editor.Node (Node(..))
import Lunarbox.Data.Editor.Node.NodeData (NodeData)
import Lunarbox.Data.Editor.Node.NodeDescriptor (describe)
import Lunarbox.Data.Editor.Node.PinLocation (Pin(..))
import Lunarbox.Data.Editor.Project (Project)
import Svg.Attributes as SA
import Svg.Elements as SE
Expand Down Expand Up @@ -73,7 +75,9 @@ nodeInput name functionData =
, functionData
, labels: mempty
, hasOutput: false
, inputColors: Array.toUnfoldable $ SA.RGB 176 112 107 <$ view _FunctionDataInputs functionData
, colorMap: Map.fromFoldable $
Array.mapWithIndex
(\index _ -> Tuple (InputPin index) $ SA.RGB 176 112 107) $ view _FunctionDataInputs functionData
}

component :: forall m. MonadEffect m => MonadAsk Config m => Component HH.HTML Query Input Output m
Expand Down
57 changes: 33 additions & 24 deletions src/Component/Editor/Node.purs
Original file line number Diff line number Diff line change
Expand Up @@ -8,12 +8,14 @@ module Lunarbox.Component.Editor.Node

import Prelude
import Data.Array (catMaybes, mapWithIndex)
import Data.Array (toUnfoldable) as Array
import Data.Array (findIndex, 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.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Symbol (SProxy(..))
import Data.Typelevel.Num (d0, d1)
Expand All @@ -28,6 +30,7 @@ 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.Editor.Node.PinLocation (Pin(..))
import Lunarbox.Data.Vector (Vec2)
import Lunarbox.Svg.Attributes (Linecap(..), arc, strokeDashArray, strokeLinecap, strokeWidth, transparent)
import Math (pi)
Expand All @@ -43,7 +46,7 @@ type State
, functionData :: FunctionData
, labels :: Array (Maybe String)
, hasOutput :: Boolean
, inputColors :: List SA.Color
, colorMap :: Map Pin SA.Color
}

-- Lenses
Expand All @@ -53,8 +56,8 @@ _nodeData = prop (SProxy :: SProxy "nodeData")
_position :: Lens' State (Vec2 Number)
_position = _nodeData <<< _NodeDataPosition

_inputColors :: Lens' State (List SA.Color)
_inputColors = prop (SProxy :: _ "inputColors")
_colorMap :: Lens' State (Map Pin SA.Color)
_colorMap = prop (SProxy :: _ "colorMap")

_zPosition :: Lens' State Int
_zPosition = _nodeData <<< _NodeDataZPosition
Expand Down Expand Up @@ -87,6 +90,10 @@ data Output
type Input
= State

-- Get a color from a color Map
getColorFrom :: forall k. Ord k => Map k SA.Color -> k -> SA.Color
getColorFrom colorMap key = fromMaybe transparent $ Map.lookup key colorMap

output :: forall r. Boolean -> HTML r Action
output false = HH.text ""

Expand Down Expand Up @@ -136,14 +143,14 @@ component =
SetSelection value -> do
modify_ $ set _stateSelected value
when (value == true) $ raise Selected
Receive { labels, inputColors } -> do
oldColors <- gets $ view _inputColors
Receive { labels, colorMap } -> do
oldColors <- gets $ view _colorMap
modify_
$ Record.merge
{ labels
, inputColors:
if List.null oldColors then
inputColors
, colorMap:
if Map.size oldColors == 0 then
colorMap
else
oldColors
}
Expand Down Expand Up @@ -186,11 +193,12 @@ component =
]
[ HH.text text ]

render :: State -> HTML _ Action
render { selectable
, nodeData: NodeData { position, selected }
, functionData
, labels
, inputColors
, colorMap
, hasOutput
} =
let
Expand All @@ -213,18 +221,19 @@ component =
SE.g
[ SA.transform [ SA.Rotate 90.0 0.0 0.0 ]
]
$ mapWithIndex
( \index arc ->
let
color = fromMaybe transparent $ List.index inputColors index

spacing = if List.length inputArcs == 1 then 0.0 else arcSpacing
in
displayArc
spacing
nodeRadius
color
arc
)
(List.toUnfoldable inputArcs)
$ ( \arc@(Arc _ _ name) ->
let
index = Array.findIndex (\input -> name == input.name) $ view _FunctionDataInputs functionData

color = fromMaybe transparent $ (getColorFrom colorMap <<< InputPin) <$> index

spacing = if List.length inputArcs == 1 then 0.0 else arcSpacing
in
displayArc
spacing
nodeRadius
color
arc
)
<$> List.toUnfoldable inputArcs
]
33 changes: 18 additions & 15 deletions src/Component/Editor/Scene.purs
Original file line number Diff line number Diff line change
Expand Up @@ -8,15 +8,16 @@ module Lunarbox.Component.Editor.Scene
import Prelude
import Control.Monad.Reader (class MonadAsk)
import Control.Monad.State (get, gets, modify_)
import Data.Array (foldr, mapWithIndex, sortBy)
import Data.Array (foldr, sortBy)
import Data.Array as Array
import Data.Default (def)
import Data.Foldable (for_, traverse_)
import Data.Int (toNumber)
import Data.Lens (Lens', Traversal', _1, _2, is, preview, set, view)
import Data.Lens.Index (ix)
import Data.Lens.Record (prop)
import Data.List (List)
import Data.List (List, (:))
import Data.List as List
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe)
Expand Down Expand Up @@ -245,6 +246,7 @@ component =
handleAction TriggerNodeGroupSaving
pure $ Just k

render :: State -> HH.HTML _ Action
render { project, expression, typeMap, typeColors, function: Tuple currentFunctionName (NodeGroup { nodes }) } =
SE.svg
[ SA.width 100000.0
Expand All @@ -265,8 +267,6 @@ component =

generateLocation = DeepLocation currentFunctionName

pinLocation = generateLocation <<< DeepLocation id <<< InputPin

location = generateLocation $ Location id

type' = Map.lookup location typeMap
Expand All @@ -275,18 +275,21 @@ component =

labels = [ show <$> type', sumarizeExpression <$> expression' ]

inputColors (FunctionData { inputs }) = fromMaybe mempty $ sequence $ mapWithIndex toColor inputs
pinLocations inputs = OutputPin : inputPints
where
toColor index _ =
let
currentLocation = pinLocation index
inputPints = List.mapWithIndex (\index _ -> InputPin index) $ Array.toUnfoldable inputs

type'' = Map.lookup currentLocation typeMap
in
type''
>>= case _ of
TVarariable name' -> Map.lookup currentLocation typeColors
type''' -> typeToColor type'''
inputColors :: FunctionData -> Map Pin Color
inputColors (FunctionData { inputs }) = Map.fromFoldable $ fromMaybe mempty $ sequence $ toColor <$> pinLocations inputs
where
toColor currentLocation =
Map.lookup fullLocation typeMap
>>= case _ of
TVarariable name' -> Map.lookup fullLocation typeColors
type''' -> typeToColor type'''
<#> Tuple currentLocation
where
fullLocation = generateLocation $ DeepLocation id currentLocation

name = case node of
ComplexNode { function } -> function
Expand All @@ -303,7 +306,7 @@ component =
, nodeData
, selectable: true
, functionData
, inputColors: Array.toUnfoldable $ inputColors functionData
, colorMap: inputColors functionData
, labels: [ Just $ show name ] <> labels
, hasOutput: not $ is _OutputNode node
}
Expand Down

0 comments on commit 2ff7081

Please sign in to comment.