Implement Erase (#4)

Implement Erase button which erases the selected item. Currently did not
implement trace segment erasing, instead just the whole trace is erased.
Implement the trace segment erasing as a separate task later.
Implements also a netsplit function that allows separation of nets when
a trace is killed from the middle. CustomNets will require still some
thinking.

src/Conductor.elm

@@ -133,6 +133,126 @@ mergeNets model snappedConductors =
             MergeNoNet conductors
 
 
+isConductorInPoints : List Point -> Conductor -> Bool
+isConductorInPoints points conductor =
+    List.foldl
+        (\p b ->
+            if b then
+                b
+
+            else
+                List.member p points
+        )
+        False
+        (conductorPoints conductor)
+
+
+{-| Given list of conductors that are known to be connected and a list of conductors that might be connected,
+return a tuple containing list of conductors that are connected together and conductors that are not connected together.
+
+In a normal use case, the connected argument should be a singleton when starting the iteratoin.
+
+-}
+findConnected : List Conductor -> List Conductor -> ( List Conductor, List Conductor )
+findConnected connected unconnected =
+    case connected of
+        [] ->
+            ( [], unconnected )
+
+        initial :: remainingConnected ->
+            let
+                initialPoints =
+                    conductorPoints initial
+
+                ( newConnected, newUnconnected ) =
+                    List.partition (isConductorInPoints initialPoints) unconnected
+
+                ( recursiveConnected, recursiveUnconnected ) =
+                    findConnected (remainingConnected ++ newConnected) newUnconnected
+            in
+            -- For every connected conductor, we redo the search with the remaining unconnected conductors
+            ( initial :: recursiveConnected, recursiveUnconnected )
+
+
+{-| splitNet function takes a net and checks it for net splits
+-}
+checkNetSplit : Net -> ModelConductors a b -> ModelConductors a b
+checkNetSplit net model =
+    let
+        modelConductors =
+            allConductors model
+
+        netConductors =
+            netsConductors modelConductors [ net ]
+    in
+    case modelConductors of
+        [] ->
+            model
+
+        initial :: rest ->
+            let
+                ( connected, unconnected ) =
+                    findConnected [ initial ] rest
+            in
+            case ( connected, unconnected ) of
+                -- Edge case: If we have only one connected, might as well split everything
+                ( [ c ], ucs ) ->
+                    splitNet model (c :: ucs)
+
+                ( _, [] ) ->
+                    model
+
+                ( _, ucs ) ->
+                    splitNet model ucs
+
+
+{-| Split the given conductors from their existing net into new net(s)
+-}
+splitNet : ModelConductors a b -> List Conductor -> ModelConductors a b
+splitNet model conductors =
+    -- TODO deal with custom net !
+    case conductors of
+        [] ->
+            model
+
+        first :: rest ->
+            let
+                net =
+                    conductorNet first
+
+                ( connected, unconnected ) =
+                    findConnected [ first ] rest
+            in
+            (case connected of
+                [] ->
+                    model
+
+                [ c ] ->
+                    setConductorsNet model [ c ] (NoNet model.nextNetId)
+                        |> (\m -> { m | nextNetId = m.nextNetId + 1 })
+
+                cs ->
+                    case net of
+                        NoNet _ ->
+                            setConductorsNet model cs (NoNet model.nextNetId)
+                                |> (\m -> { m | nextNetId = m.nextNetId + 1 })
+
+                        AutoNet _ ->
+                            setConductorsNet model cs (AutoNet model.nextNetId)
+                                |> (\m -> { m | nextNetId = m.nextNetId + 1 })
+
+                        CustomNet _ _ ->
+                            -- TODO !
+                            model
+            )
+                |> (\m -> splitNet m unconnected)
+
+
+setConductorsNet : ModelConductors a b -> List Conductor -> Net -> ModelConductors a b
+setConductorsNet model conductors net =
+    List.foldl (updateConductorNet net) model conductors
+
+
 type Conductor
     = Surface SurfaceConductor
     | Through ThroughConductor
@@ -330,6 +450,33 @@ addThroughConductor toConductor model =
             { model | nextNetId = model.nextNetId + 1, conductors = ThroughPad pad point radius net :: model.conductors }
 
 
+removeConductor : Conductor -> ModelConductors a b -> ModelConductors a b
+removeConductor conductor model =
+    case conductor of
+        Through c ->
+            removeThroughConductor model c
+
+        Surface c ->
+            removeSurfaceConductor model c
+
+
+removeThroughConductor : ModelConductors a b -> ThroughConductor -> ModelConductors a b
+removeThroughConductor model tc =
+    { model | conductors = List.filter (\x -> x /= tc) model.conductors }
+
+
+removeSurfaceConductor : ModelConductors a b -> SurfaceConductor -> ModelConductors a b
+removeSurfaceConductor model sc =
+    { model
+        | layers =
+            List.map
+                (\l ->
+                    { l | conductors = List.filter (\x -> x /= sc) l.conductors }
+                )
+                model.layers
+    }
+
+
 addSurfaceConductorNoNet : (Net -> SurfaceConductor) -> ModelConductors a b -> ModelConductors a b
 addSurfaceConductorNoNet toSurfaceConductor model =
     case model.layers of

src/Io.elm

@@ -25,6 +25,7 @@ type alias MainModel =
     , canvasBoundingClientRect : BoundingClientRect
     , timeline : WorkspaceTimeline
     , keyDownPreventDefault : Bool
+    , ePressed : Bool
     , zPressed : Bool
     , xPressed : Bool
     , vPressed : Bool
@@ -113,6 +114,7 @@ decodeMainModel last layerB64DataList =
         |> hardcoded last.canvasBoundingClientRect
         |> required "workspace" (Decode.map (\ws -> { defaultWorkspaceTimeline | current = ws }) (decodeWorkspace last.timeline.current))
         |> hardcoded last.keyDownPreventDefault
+        |> hardcoded last.ePressed
         |> hardcoded last.zPressed
         |> hardcoded last.xPressed
         |> hardcoded last.vPressed

src/Main.elm

@@ -119,6 +119,7 @@ init _ =
       , canvasBoundingClientRect = BoundingClientRect 0 0 0 0 0
       , timeline = defaultWorkspaceTimeline
       , keyDownPreventDefault = True
+      , ePressed = False
       , zPressed = False
       , xPressed = False
       , vPressed = False
@@ -148,6 +149,7 @@ type Msg
     | KeyDown Key
     | KeyUp Key
     | Workspace Workspace.Msg
+    | Erase
     | Undo
     | Redo
     | StartCapture
@@ -404,6 +406,12 @@ doUpdate msg model =
                         -- d
                         fromWorkspaceUpdate (Workspace.update (Workspace.ToolMsg <| Tool.SetTool <| Tool.CreateTraceTool [] Conductor.NoInteraction) model.timeline.current) model
 
+                    -- Partiboi
+                    69 ->
+                        -- e
+                        update Erase model
+                            |> chainUpdate (\m -> ( { m | ePressed = True }, Cmd.none ))
+
                     90 ->
                         -- z
                         update Undo model
@@ -446,6 +454,11 @@ doUpdate msg model =
                     -- ctrl
                     ( { model | ctrl = False }, Cmd.none )
 
+                -- Partiboi
+                69 ->
+                    -- e
+                    ( { model | ePressed = False }, Cmd.none )
+
                 86 ->
                     -- v
                     ( { model | vPressed = False }, Cmd.none )
@@ -471,6 +484,9 @@ doUpdate msg model =
                             identity
                    )
 
+        Erase ->
+            update (Workspace <| Workspace.ToolMsg Tool.Erase) model
+
         Undo ->
             undo model
                 |> chainUpdate (\m -> ( m, setLayers ( List.filterMap (toExternalLayer m) m.timeline.current.layers, False ) ))
@@ -908,6 +924,11 @@ sidebar model =
                 , onClick <| toolMsg <| Tool.SetTool <| Tool.CreateDistanceDimension Nothing
                 ]
                 [ text "Gauge", span [ class "keycode" ] [ text "w" ] ]
+            , button
+                [ activeClass model.ePressed
+                , onClick Erase
+                ]
+                [ text "Erase", span [ class "keycode" ] [ text "e" ] ]
             ]
         , div [ id "key-row-2" ]
             [ button

src/Tool.elm

@@ -1,30 +1,7 @@
 module Tool exposing (..)
 
 import Common exposing (Dimension(..), Point, Radius, ReferenceFrame, Thickness, ThreePoints(..), TwoPoints(..), chainUpdate3)
-import Conductor
-    exposing
-        ( Conductor
-        , ConstructionPoint(..)
-        , Highlight
-        , Interaction(..)
-        , InteractionInformation
-        , MergeNet(..)
-        , ModelConductors
-        , Net(..)
-        , Selection
-        , SurfaceConductor(..)
-        , ThroughConductor(..)
-        , activeLayerSurfaceConductors
-        , addSurfaceConductor
-        , addSurfaceConductorNoNet
-        , addThroughConductor
-        , constructionPointsToConductors
-        , constructionPointsToTrace
-        , incrementNextNetId
-        , mergeNets
-        , snapTo
-        , updateConductorNet
-        )
+import Conductor exposing (Conductor, ConstructionPoint(..), Highlight, Interaction(..), InteractionInformation, MergeNet(..), ModelConductors, Net(..), Selection, SurfaceConductor(..), ThroughConductor(..), activeLayerSurfaceConductors, addSurfaceConductor, addSurfaceConductorNoNet, addThroughConductor, checkNetSplit, conductorNet, constructionPointsToConductors, constructionPointsToTrace, incrementNextNetId, mergeNets, removeConductor, snapTo, updateConductorNet)
 import Form
 import Vector exposing (generateDoubleRow, generateSingleRow)
 
@@ -213,6 +190,7 @@ type Msg
     | Reset
     | SetSubTool Int
     | FormMsg Form.Msg
+    | Erase
 
 
 type alias ModelTools a =
@@ -626,6 +604,42 @@ update toMsg msg model =
         FormMsg formMsg ->
             Form.update (toMsg << FormMsg) formMsg model
 
+        Erase ->
+            case model.tool of
+                SelectTool selection _ ->
+                    case selection of
+                        NoInteraction ->
+                            ( model, Cmd.none, False )
+
+                        PointInteraction conductors point ->
+                            ( List.foldl
+                                (\c m ->
+                                    let
+                                        net =
+                                            conductorNet c
+                                    in
+                                    removeConductor c m
+                                        |> checkNetSplit net
+                                )
+                                model
+                                conductors
+                                |> (\m -> { m | tool = setToolSelection m.tool NoInteraction })
+                            , Cmd.none
+                            , True
+                            )
+
+                        SegmentInteraction conductor p1 p2 ->
+                            -- TODO this should remove only a segment, not the whole trace!
+                            ( removeConductor conductor model |> (\m -> { m | tool = setToolSelection m.tool NoInteraction }), Cmd.none, False )
+
+                        NetInteraction net ->
+                            -- Do we want to wreck the whole net?
+                            -- Hey that rhymes
+                            ( model, Cmd.none, False )
+
+                _ ->
+                    ( model, Cmd.none, False )
+
 
 resetModelTool : { a | tool : Tool } -> { a | tool : Tool }
 resetModelTool model =

src/Visual.elm

@@ -106,6 +106,8 @@ viewVisualElement model element =
             viewSquare point
                 width
                 [ SvgA.fill <| deriveColor model element
+                , SvgE.stopPropagationOn "click" (Decode.succeed ( Click element, True ))
+                , SvgE.stopPropagationOn "mouseover" (Decode.succeed ( MouseOver element, True ))
                 ]
                 (Maybe.map (\t -> ( t, "white" )) maybeText)
 

src/Workspace.elm

@@ -193,6 +193,12 @@ update msg model =
                         Visual.Line conductor p1 p2 _ ->
                             ( { model | tool = Tool.setToolSelection model.tool (Conductor.SegmentInteraction conductor p1 p2) }, Cmd.none, True )
 
+                        Visual.Circle conductor point _ _ ->
+                            ( { model | tool = Tool.setToolSelection model.tool (Conductor.PointInteraction [ conductor ] point) }, Cmd.none, True )
+
+                        Visual.Square conductor point _ _ ->
+                            ( { model | tool = Tool.setToolSelection model.tool (Conductor.PointInteraction [ conductor ] point) }, Cmd.none, True )
+
                         Visual.Background ->
                             ( { model | tool = Tool.setToolSelection model.tool Conductor.NoInteraction }, Cmd.none, False )
 
@@ -211,6 +217,9 @@ update msg model =
                         Visual.Circle conductor point _ _ ->
                             ( { newModel | tool = Tool.setToolHighlight model.tool (Conductor.PointInteraction [ conductor ] point) }, Cmd.none, True )
 
+                        Visual.Square conductor point _ _ ->
+                            ( { newModel | tool = Tool.setToolHighlight model.tool (Conductor.PointInteraction [ conductor ] point) }, Cmd.none, True )
+
                         Visual.Background ->
                             ( { newModel | tool = Tool.setToolHighlight model.tool Conductor.NoInteraction }, Cmd.none, False )
 
@@ -219,7 +228,7 @@ update msg model =
 
                 Visual.MouseOut visualElement ->
                     -- TODO?
-                    (model, Cmd.none, False)
+                    ( model, Cmd.none, False )
 
         ToolMsg toolMsg ->
             Tool.update ToolMsg toolMsg model

vite.config.js

@@ -1,4 +1,4 @@
-import { defineConfig } from 'vite'
+import {defineConfig} from 'vite'
 import elmPlugin from 'vite-plugin-elm'
 // vite.config.js
 export default defineConfig({
@@ -7,6 +7,7 @@ export default defineConfig({
   base: "/cirdis/",
   plugins: [elmPlugin()],
   build: {
-    outDir: "../docs/"
+    outDir: "../docs/",
+    emptyOutDir: true
   }
 })