Changes to return (side,XYPos). Ignore SelectedComponentView.fs

This commit is contained in:
Giorgos Vyronos 2022-03-09 14:37:33 +00:00
parent 51b5cbdb32
commit 6d9ba7714b
4 changed files with 58 additions and 26 deletions

View file

@ -660,7 +660,7 @@ let view (model : Model) (dispatch : Dispatch<Msg>) =
Segments = List.map makeSegPos wire.Segments
ColorP = wire.Color
StrokeWidthP = wire.Width
OutputPortLocation = outputPortLocation
OutputPortLocation = snd outputPortLocation
}
singleWireView props)
TimeHelpers.instrumentInterval "WirePrepareProps" rStart ()
@ -763,8 +763,8 @@ let routeGivenWiresBasedOnPortPositions (wiresToBeRouted : list<ConnectionId>) (
|> List.map
(
fun wire ->
let posTuple = Symbol.getTwoPortLocations (model.Symbol) (wire.InputPort) (wire.OutputPort)
(wire.Id, {wire with Segments = makeInitialSegmentsList wire.Id posTuple})
let posTuple1,posTuple2 = Symbol.getTwoPortLocations (model.Symbol) (wire.InputPort) (wire.OutputPort)
(wire.Id, {wire with Segments = makeInitialSegmentsList wire.Id (snd posTuple1, snd posTuple2)})
)
|> Map.ofList
@ -990,8 +990,8 @@ let filterWiresByCompMoved (wModel : Model) (compIds : list<ComponentId>) =
//Returns a newly autorouted wire given a model and wire
let autorouteWire (model : Model) (wire : Wire) : Wire =
let posTuple = Symbol.getTwoPortLocations (model.Symbol) (wire.InputPort) (wire.OutputPort)
{wire with Segments = makeInitialSegmentsList wire.Id posTuple}
let posTuple1,posTuple2 = Symbol.getTwoPortLocations (model.Symbol) (wire.InputPort) (wire.OutputPort)
{wire with Segments = makeInitialSegmentsList wire.Id (snd posTuple1,snd posTuple2)}
/// reverse segment order, and Start, End coordinates, so list can be processed from input to output
/// this function is self-inverse
@ -1134,10 +1134,10 @@ let updateWire (model : Model) (wire : Wire) (inOut : bool) =
| true -> Symbol.getInputPortLocation model.Symbol wire.InputPort
| false -> Symbol.getOutputPortLocation model.Symbol wire.OutputPort
if inOut then
partialAutoRoute (revSegments wire.Segments) newPort
partialAutoRoute (revSegments wire.Segments) (snd newPort)
|> Option.map revSegments
else
partialAutoRoute wire.Segments newPort
partialAutoRoute wire.Segments (snd newPort)
|> Option.map (fun segs -> {wire with Segments = segs})
|> Option.defaultValue (autorouteWire model wire)
@ -1259,7 +1259,7 @@ let update (msg : Msg) (model : Model) : Model*Cmd<Msg> =
let portOnePos, portTwoPos = Symbol.getTwoPortLocations model.Symbol inputId outputId
let wireWidthFromSymbol = WireWidth.Configured 1
let wireId = ConnectionId(JSHelpers.uuid())
let segmentList = makeInitialSegmentsList wireId (portOnePos, portTwoPos)
let segmentList = makeInitialSegmentsList wireId (snd portOnePos, snd portTwoPos)
let newWire =
{
@ -1448,11 +1448,11 @@ let update (msg : Msg) (model : Model) : Model*Cmd<Msg> =
let makeWirePosMatchSymbol inOut (wire:Wire) =
match inOut with
| true -> posMatchesVertex
(Symbol.getInputPortLocation model.Symbol inputId)
(snd (Symbol.getInputPortLocation model.Symbol inputId))
(List.head conn.Vertices)
| false ->
posMatchesVertex
(Symbol.getOutputPortLocation model.Symbol outputId)
(snd (Symbol.getOutputPortLocation model.Symbol outputId))
(List.last conn.Vertices)
|> (fun b ->
if b then
@ -1519,7 +1519,7 @@ let pasteWires (wModel : Model) (newCompIds : list<ComponentId>) : (Model * list
| Some (newInputPort, newOutputPort) ->
let portOnePos, portTwoPos = Symbol.getTwoPortLocations wModel.Symbol (InputPortId newInputPort) (OutputPortId newOutputPort)
let segmentList = makeInitialSegmentsList newId (portOnePos, portTwoPos)
let segmentList = makeInitialSegmentsList newId (snd portOnePos, snd portTwoPos)
[
{
oldWire with

View file

@ -422,8 +422,9 @@ let findNearbyPorts (model: Model) =
/// Returns what is located at pos
/// Priority Order: InputPort -> OutputPort -> Component -> Wire -> Canvas
let mouseOn (model: Model) (pos: XYPos) : MouseOn =
let inputPorts, outputPorts = findNearbyPorts model
let inputPortsWithSide, outputPortsWithSide = findNearbyPorts model
let inputPorts = List.map(fun (outPort,(orient,location)) -> outPort,location) inputPortsWithSide
let outputPorts = List.map(fun (outPort,(orient,location)) -> outPort,location) outputPortsWithSide
//TODO FIX THIS - QUICK FIX TO MAKE WORK, NOT IDEAL
//The ports/wires are being loaded in the correct place but the detection is not working
//Something is wrong with the mouse coordinates somewhere, might be caused by zoom? not sure
@ -682,7 +683,8 @@ let mDragUpdate (model: Model) (mMsg: MouseT) : Model * Cmd<Msg> =
moveSymbols model mMsg
| ConnectingInput _ ->
let nearbyComponents = findNearbyComponents model mMsg.Pos
let _, nearbyOutputPorts = findNearbyPorts model
let _, nearbyOutputPortsWithSide = findNearbyPorts model
let nearbyOutputPorts = List.map(fun (outPort,(orient,location)) -> outPort,location)nearbyOutputPortsWithSide
let targetPort, drawLineTarget =
match mouseOnPort nearbyOutputPorts mMsg.Pos 12.5 with
@ -698,8 +700,8 @@ let mDragUpdate (model: Model) (mMsg: MouseT) : Model * Cmd<Msg> =
, Cmd.ofMsg CheckAutomaticScrolling
| ConnectingOutput _ ->
let nearbyComponents = findNearbyComponents model mMsg.Pos
let nearbyInputPorts, _ = findNearbyPorts model
let nearbyInputPortsWithSide, _ = findNearbyPorts model
let nearbyInputPorts = List.map(fun (outPort,(orient,location)) -> outPort,location) nearbyInputPortsWithSide
let targetPort, drawLineTarget =
match mouseOnPort nearbyInputPorts mMsg.Pos 12.5 with
| Some (InputPortId portId, portLoc) -> (portId, portLoc) // If found target, snap target of the line to the port

View file

@ -765,7 +765,7 @@ let canvasPortLocation (sym:Symbol) : XYPos list =
// Function to generate the true XYPos of a specified Port on the Canvas given the port and symbol
// Input: Symbol, Port -> Take the symbol and the specified port
// Output: XYPos-> Return the XYPos position of the ports depending on being inputs or outputs
let getGlobalPortPos (sym: Symbol) (port:Port) :XYPos =
let getGlobalPortPos (sym: Symbol) (port:Port) : (PortOrientation*XYPos) =
let typePort,ports =
if port.PortType = PortType.Input then
("I",sym.Compo.InputPorts)
@ -773,13 +773,15 @@ let getGlobalPortPos (sym: Symbol) (port:Port) :XYPos =
("O",sym.Compo.OutputPorts)
let index = float( List.findIndex (fun (p:Port) -> p = port) ports )
(Map.find (typePort + string index) sym.APortOffsetsMap).Offset
let positionOffset = (Map.find (typePort + string index) sym.APortOffsetsMap)
(positionOffset.Side,positionOffset.Offset)
/// It is used in getInputPortLocation for a single port
let getInputPortsPositionMap (symbols: Symbol list) =
symbols
|> List.collect (fun sym -> List.map (fun p -> sym,p) sym.Compo.InputPorts)
|> List.map (fun (sym,port) -> (InputPortId port.Id, posAdd (getGlobalPortPos sym port) sym.Pos))
|> List.map (fun (sym,port) -> (InputPortId port.Id,((fst (getGlobalPortPos sym port)), posAdd (snd (getGlobalPortPos sym port)) sym.Pos)))
|> Map.ofList
@ -787,7 +789,7 @@ let getInputPortsPositionMap (symbols: Symbol list) =
let getOutputPortsPositionMap (symbols: Symbol list) =
symbols
|> List.collect (fun sym -> List.map (fun p -> sym,p) sym.Compo.OutputPorts)
|> List.map (fun (sym,port) -> (OutputPortId port.Id , posAdd (getGlobalPortPos sym port) sym.Pos))
|> List.map (fun (sym,port) -> (OutputPortId port.Id ,((fst (getGlobalPortPos sym port)), posAdd (snd (getGlobalPortPos sym port)) sym.Pos)))
|> Map.ofList
///Returns the port object associated with a given portId
@ -837,7 +839,7 @@ let getOnePortLocation (symModel: Model) (portId : string) (pType: PortType)=
getOutputPortLocation symModel (OutputPortId portId)
/// Returns the location of a given portId, with better efficiency
let getOnePortLocationNew (symModel: Model) (portId : string) (pType: PortType) : XYPos =
let getOnePortLocationNew (symModel: Model) (portId : string) (pType: PortType): PortOrientation * XYPos =
symModel.Symbols
|> Map.pick (fun _ sym ->
let comp = sym.Compo
@ -845,7 +847,7 @@ let getOnePortLocationNew (symModel: Model) (portId : string) (pType: PortType)
List.tryFind (fun (po:Port) -> po.Id = portId) comp.InputPorts
else
List.tryFind (fun (po:Port) -> po.Id = portId) comp.OutputPorts
|> Option.map (fun port -> posAdd (getGlobalPortPos sym port) sym.Pos))
|> Option.map (fun port ->((fst (getGlobalPortPos sym port)), posAdd (snd (getGlobalPortPos sym port)) sym.Pos)))
/// Returns the locations of a given input portId and output portId
@ -1317,6 +1319,9 @@ let update (msg : Msg) (model : Model): Model*Cmd<'a> =
let extractComponent (symModel: Model) (sId:ComponentId) : Component =
symModel.Symbols[sId].Compo
let extractSymbol (symModel: Model) (sId:ComponentId) : Symbol =
symModel.Symbols[sId]
let extractComponents (symModel: Model) : Component list =
symModel.Symbols
|> Map.toList

View file

@ -384,6 +384,8 @@ let private makeExtraInfo model (comp:Component) text dispatch =
let viewSelectedComponent (model: ModelType.Model) dispatch =
let sheetDispatch sMsg = dispatch (Sheet sMsg)
let formatLabelText (txt: string) =
txt.ToUpper()
@ -392,7 +394,12 @@ let viewSelectedComponent (model: ModelType.Model) dispatch =
|> (fun chars -> match Seq.length chars with | 0 -> None | _ -> Some (String.concat "" (Seq.map string chars)))
match model.Sheet.SelectedComponents with
| [ compId ] ->
let comp = Symbol.extractComponent model.Sheet.Wire.Symbol compId
let comp = Symbol.extractComponent model.Sheet.Wire.Symbol compId // Extract Component : function in Symbol.fs
let sym = Symbol.extractSymbol model.Sheet.Wire.Symbol compId // Extract Symbol : function in Symbol.fs
let ports =
sym.APortOffsetsMap
|> Map.toList
|> List.map fst
div [Key comp.Id] [
// let label' = extractLabelBase comp.Label
// TODO: normalise labels so they only contain allowed chars all uppercase
@ -411,6 +418,24 @@ let viewSelectedComponent (model: ModelType.Model) dispatch =
//updateNames model (fun _ _ -> model.WaveSim.Ports) |> StartWaveSim |> dispatch
dispatch (ReloadSelectedComponent model.LastUsedDialogWidth) // reload the new component
)
let items =
List.map (fun i ->
textFormField required "Component Rent" i (fun text ->
// TODO: removed formatLabel for now
//setComponentLabel model sheetDispatch comp (formatLabel comp text)
match formatLabelText text with
| Some label ->
setComponentLabel model sheetDispatch comp label
dispatch <| SetPopupDialogText (Some label)
| None -> ()
//updateNames model (fun _ _ -> model.WaveSim.Ports) |> StartWaveSim |> dispatch
dispatch (ReloadSelectedComponent model.LastUsedDialogWidth) // reload the new component
)) ports
printf "%A" items
match items with
| [x] -> x
| _ -> nothing
]
| _ -> div [] [ str "Select a component in the diagram to view or change its properties, for example number of bits." ]