From 6892b93881fef82744093489877975511609e63d Mon Sep 17 00:00:00 2001 From: timothycdc Date: Wed, 10 Apr 2024 14:30:01 +0100 Subject: [PATCH 01/20] dev mode ported to master --- src/Renderer/Common/CommonTypes.fs | 174 ++--- src/Renderer/Model/ModelType.fs | 41 +- src/Renderer/Renderer.fs | 868 +++++++++++------------ src/Renderer/Renderer.fsproj | 2 + src/Renderer/UI/DeveloperModeHelpers.fs | 450 ++++++++++++ src/Renderer/UI/DeveloperModeView.fs | 515 ++++++++++++++ src/Renderer/UI/MainView.fs | 149 ++-- src/Renderer/UI/SelectedComponentView.fs | 438 ++++++------ src/Renderer/UI/Style.fs | 18 +- src/Renderer/UI/Update.fs | 102 +-- src/Renderer/UI/UpdateHelpers.fs | 218 +++--- 11 files changed, 2019 insertions(+), 956 deletions(-) create mode 100644 src/Renderer/UI/DeveloperModeHelpers.fs create mode 100644 src/Renderer/UI/DeveloperModeView.fs diff --git a/src/Renderer/Common/CommonTypes.fs b/src/Renderer/Common/CommonTypes.fs index 8d67f5b56..057269dbf 100644 --- a/src/Renderer/Common/CommonTypes.fs +++ b/src/Renderer/Common/CommonTypes.fs @@ -3,7 +3,7 @@ *) module CommonTypes - open Fable.Core + open Fable.Core open Optics #if FABLE_COMPILER open Thoth.Json @@ -21,34 +21,34 @@ module CommonTypes } static member inline zero: XYPos = {X=0.; Y=0.} - + /// allowed tolerance when comparing positions with floating point errors for equality static member inline epsilon = 0.0000001 - + /// Add postions as vectors (overlaoded operator) static member inline ( + ) (left: XYPos, right: XYPos) = { X = left.X + right.X; Y = left.Y + right.Y } - + /// Subtract positions as vectors (overloaded operator) static member inline ( - ) (left: XYPos, right: XYPos) = { X = left.X - right.X; Y = left.Y - right.Y } - + /// Scale a position by a number (overloaded operator). static member inline ( * ) (pos: XYPos, scaleFactor: float) = { X = pos.X*scaleFactor; Y = pos.Y * scaleFactor } - - /// Compare positions as vectors. Comparison is approximate so + + /// Compare positions as vectors. Comparison is approximate so /// it will work even with floating point errors. New infix operator. static member inline ( =~ ) (left: XYPos, right: XYPos) = abs (left.X - right.X) <= XYPos.epsilon && abs (left.Y - right.Y) <= XYPos.epsilon - - let inline euclideanDistance (pos1: XYPos) (pos2:XYPos) = + + let inline euclideanDistance (pos1: XYPos) (pos2:XYPos) = let vec = pos1 - pos2 sqrt(vec.X**2 + vec.Y**2) - + /// example use of comparison operator: note that F# type inference will not work without at least /// one of the two operator arguments having a known XYPos type. - let private testXYPosComparison a (b:XYPos) = + let private testXYPosComparison a (b:XYPos) = a =~ b /// display XYPos as string nicely for debugging @@ -56,7 +56,7 @@ module CommonTypes if max (abs x) (abs y) > 20. then $"(%.0f{x},%.0f{y})" else - $"(%.2f{x},%.2f{y})" + $"(%.2f{x},%.2f{y})" //==========================================// @@ -84,7 +84,7 @@ module CommonTypes 6. For symbols port numbers determine the vertical order in which ports are displayed. 7. Thus when changing the order of number of I/Os on a custom component port numbers can be changed as long as port lists and port name lists are similarly re-ordered. - 8. In the simulation port numbers are not relevant for custom comps - connections match port names with the + 8. In the simulation port numbers are not relevant for custom comps - connections match port names with the sheet input or output component for the port 9. In the simulation port numbers matter for all other ports: the simulator defines operation based on them. 10.In model.Symbol ports are kept in a single global map, including port numbers. If port numbers are permuted on @@ -97,7 +97,7 @@ module CommonTypes /// A component I/O. /// /// Id (like any other Id) is a string generated with 32 random hex charactes, - /// so it is (practically) globally unique. These Ids are used + /// so it is (practically) globally unique. These Ids are used /// to uniquely refer to ports and components. They are generated via uuid(). /// /// PortNumber is used to identify which port is which on a component, contiguous from 0 @@ -108,13 +108,13 @@ module CommonTypes type Port = { Id : string // For example, an And would have input ports 0 and 1, and output port 0. - // If the port is used in a Connection record as Source or Target, the Number is None. + // If the port is used in a Connection record as Source or Target, the Number is None. PortNumber : int option - PortType : PortType + PortType : PortType HostId : string } - + type PortId = | PortId of string // NB - this.Text() is not currently used. @@ -132,8 +132,8 @@ module CommonTypes | Six -> "6px" | Seven -> "7px" | Eight -> "8px" - - + + /// Type to specify the origin of a custom component type CCForm = |User @@ -162,7 +162,7 @@ module CommonTypes type Memory = { // How many bits the address should have. // The memory will have 2^AddressWidth memory locations. - AddressWidth : int + AddressWidth : int // How wide each memory word should be, in bits. WordWidth : int // Data is a list of <2^AddressWidth> elements, where each element is a @@ -172,8 +172,8 @@ module CommonTypes Data : Map } - - type InitMemData = + + type InitMemData = | FromData // old method (from data field) | FromFile of string // FromFile fName => read a file fName.ram for data | ToFile of string // ToFile fName => write data to a file fName.ram @@ -187,22 +187,22 @@ module CommonTypes Init: InitMemData // How many bits the address should have. // The memory will have 2^AddressWidth memory locations. - AddressWidth : int + AddressWidth : int // How wide each memory word should be, in bits. WordWidth : int // Data is a list of <2^AddressWidth> elements, where each element is a // 64 bit integer. This makes words longer than 64 bits not supported. // This can be changed by using strings instead of int64, but that is way // less memory efficient. - Data : Map - } + Data : Map + } + - type ShiftComponentType = |LSL |LSR |ASR - + [] type GateComponentType = | And @@ -214,14 +214,14 @@ module CommonTypes /// Option of this qualifies NBitsXOr to allow many different components /// None => Xor - /// TODO to reduce technical debt: + /// TODO to reduce technical debt: /// Rename NbitsXor as NBitsCustom, put all the Nbits ops into this D.U. /// Change catalog entries for all NBits ops to use NBitsCustom, alter load to remain compatibility. type NBitsArithmetic = | Multiply //Divide uncomment or add new cases to implement additional N bit operations. (match warnings will show what must be added) //Modulo - + // Each case contains the data needed to define a digital component of given Type // Used to read .dgm files, which may contain legacy ComponentType D.U. cases no longer used // Any NEW case added here must also be added (with identical from) to JSONComponentType @@ -240,10 +240,10 @@ module CommonTypes | Not | Decode4 | GateN of GateType: GateComponentType * NumInputs: int | Mux2 | Mux4 | Mux8 | Demux2 | Demux4 | Demux8 - | NbitsAdder of BusWidth: int | NbitsAdderNoCin of BusWidth: int - | NbitsAdderNoCout of BusWidth: int | NbitsAdderNoCinCout of BusWidth: int + | NbitsAdder of BusWidth: int | NbitsAdderNoCin of BusWidth: int + | NbitsAdderNoCout of BusWidth: int | NbitsAdderNoCinCout of BusWidth: int | NbitsXor of BusWidth:int * ArithmeticOp: NBitsArithmetic option - | NbitsAnd of BusWidth: int + | NbitsAnd of BusWidth: int | NbitsNot of BusWidth: int | NbitsOr of BusWidth: int | NbitSpreader of BusWidth: int | Custom of CustomComponentType // schematic sheet used as component @@ -262,7 +262,7 @@ module CommonTypes // legacy cases to be deleted? | BusCompare of BusWidth: int * CompareValue: uint32 | Input of BusWidth: int - | Constant of Width: int * ConstValue: int64 + | Constant of Width: int * ConstValue: int64 @@ -273,12 +273,12 @@ module CommonTypes match cType with | GateN (_, n) when n = 2 -> IsBinaryGate | _ -> NotBinaryGate - + let inline isNegated gateType = match gateType with | Nand | Nor | Xnor -> true | And | Or | Xor -> false - + let (|IsGate|NoGate|) cType = match cType with | GateN _ -> IsGate @@ -296,7 +296,7 @@ module CommonTypes let (|Memory|_|) (typ:ComponentType) = match typ with - | RAM1 mem + | RAM1 mem | AsyncRAM1 mem | ROM1 mem | AsyncROM1 mem -> Some mem @@ -314,12 +314,12 @@ module CommonTypes // --------------- Types needed for symbol ---------------- // /// Represents the rotation of a symbol in degrees, Degree0 is the default symbol rotation. /// Angle is anticlockwise - + type Rotation = | Degree0 | Degree90 | Degree180 | Degree270 - + /// Stores the rotation and the flip of the symbol, flipped false by default type STransform = {Rotation: Rotation; flipped: bool} - + /// Represents the sides of a component type Edge = @@ -327,7 +327,7 @@ module CommonTypes | Bottom | Left | Right - + /// HLP23: AUTHOR dgs119 member this.Opposite = match this with @@ -338,7 +338,7 @@ module CommonTypes /// Holds possible directions to sort ports. /// HLP23: AUTHOR dgs119 - + type Direction = | Clockwise | AntiClockwise @@ -355,8 +355,18 @@ module CommonTypes W: float /// Height H: float - } - with member this.Centre() = this.TopLeft + {X=this.W/2.; Y=this.H/2.} + } + + with + member this.Centre() = this.TopLeft + {X=this.W/2.; Y=this.H/2.} + + /// TDC21: allowed tolerance when comparing positions with floating point errors for equality + /// define a static member BoundingBox for comparisons, to be used in D1 + static member inline epsilon = 0.0000001 + static member inline (=~)(left: BoundingBox, right: BoundingBox) = + (left.TopLeft =~ right.TopLeft) + && abs (left.W - right.W) <= BoundingBox.epsilon + && abs (left.H - right.H) <= BoundingBox.epsilon let topLeft_ = Lens.create (fun a -> a.TopLeft) (fun s a -> {a with TopLeft = s}) @@ -365,7 +375,7 @@ module CommonTypes type ScaleAdjustment = | Horizontal | Vertical - + type SymbolInfo = { LabelBoundingBox: BoundingBox option LabelRotation: Rotation option @@ -394,11 +404,11 @@ module CommonTypes Id : string Type : ComponentType /// All components have a label that may be empty: label is not unique - Label : string + Label : string // position on this list determines inputPortNumber - InputPorts : Port list + InputPorts : Port list /// position in this list determines OutputPortNumber - OutputPorts : Port list + OutputPorts : Port list X : float Y : float /// Height @@ -410,10 +420,10 @@ module CommonTypes SymbolInfo : SymbolInfo option } - with member this.getPort (PortId portId: PortId) = + with member this.getPort (PortId portId: PortId) = List.tryFind (fun (port:Port) -> port.Id = portId ) (this.InputPorts @ this.OutputPorts) - - + + let type_ = Lens.create (fun c -> c.Type) (fun n c -> {c with Type = n}) let inputPorts_ = Lens.create (fun c -> c.InputPorts) (fun n c -> {c with InputPorts = n}) let outputPorts_ = Lens.create (fun c -> c.OutputPorts) (fun n c -> {c with OutputPorts = n}) @@ -433,7 +443,7 @@ module CommonTypes /// F# data describing the contents of a single schematic sheet. type CanvasState = Component list * Connection list - + /// reduced version of CanvasState for electrical comparison, all geometry removed, components ordered type ReducedCanvasState = | ReducedCanvasState of CanvasState @@ -469,10 +479,10 @@ module CommonTypes | Not | And | Or | Xor | Nand | Nor | Xnor | Decode4 | GateN of GateType: GateComponentType * NumInputs: int | Mux2 | Mux4 | Mux8 | Demux2 | Demux4 | Demux8 - | NbitsAdder of BusWidth: int | NbitsAdderNoCin of BusWidth: int - | NbitsAdderNoCout of BusWidth: int | NbitsAdderNoCinCout of BusWidth: int + | NbitsAdder of BusWidth: int | NbitsAdderNoCin of BusWidth: int + | NbitsAdderNoCout of BusWidth: int | NbitsAdderNoCinCout of BusWidth: int | NbitsXor of BusWidth:int * ArithmeticOp: NBitsArithmetic option - | NbitsAnd of BusWidth: int + | NbitsAnd of BusWidth: int | NbitsNot of BusWidth: int | NbitsOr of BusWidth: int | NbitSpreader of BusWidth: int | Custom of CustomComponentType // schematic sheet used as component @@ -491,7 +501,7 @@ module CommonTypes //---------------Legacy cases not in the Issie ComponentType here-------------------// | BusCompare of BusWidth: int * CompareValue: uint32 | Input of BusWidth: int - | Constant of Width: int * ConstValue: int64 + | Constant of Width: int * ConstValue: int64 @@ -516,7 +526,7 @@ module CommonTypes /// The default transform unboxes the value which works when there is no chnage in the JS value /// representation let convertFromJSONComponent (comp: JSONComponent.Component) : Component = - let newType (ct: JSONComponent.ComponentType) : ComponentType = + let newType (ct: JSONComponent.ComponentType) : ComponentType = match ct with | JSONComponent.ComponentType.Input1 (a,b) -> Input1 (a,b) | JSONComponent.ComponentType.Output x -> Output x @@ -558,7 +568,7 @@ module CommonTypes | JSONComponent.ComponentType.DFF -> DFF | JSONComponent.ComponentType.DFFE -> DFFE | JSONComponent.ComponentType.Register x -> Register x - | JSONComponent.ComponentType.RegisterE x -> RegisterE x + | JSONComponent.ComponentType.RegisterE x -> RegisterE x | JSONComponent.ComponentType.Counter x -> Counter x | JSONComponent.ComponentType.CounterNoLoad x -> CounterNoLoad x | JSONComponent.ComponentType.CounterNoEnable x -> CounterNoEnable x @@ -679,20 +689,20 @@ module CommonTypes - - - + + + // This code is for VERY OLD circuits... let legacyTypesConvert (lComps, lConns) = let convertConnection (c:LegacyCanvas.LegacyConnection) : Connection = { - Id=c.Id; + Id=c.Id; Source=c.Source; Target=c.Target; - Vertices = + Vertices = c.Vertices - |> List.map (function + |> List.map (function | (x,y) when x >= 0. && y >= 0. -> (x,y,false) | (x,y) -> (abs x, abs y, true)) } @@ -709,7 +719,7 @@ module CommonTypes H = comp.H W = comp.W SymbolInfo = None - + } let comps = List.map convertComponent lComps let conns = List.map convertConnection lConns @@ -732,7 +742,7 @@ module CommonTypes /// The Text() method converts it to the correct HTML string /// Where speed matters the color must be added as a case in the match statement type HighLightColor = Red | Blue | Yellow | Green | Orange | Grey | White | Purple | DarkSlateGrey | Thistle | Brown |SkyBlue - with + with member this.Text() = // the match statement is used for performance match this with | Red -> "Red" @@ -745,8 +755,8 @@ module CommonTypes | DarkSlateGrey -> "darkslategrey" | Thistle -> "thistle" | c -> sprintf "%A" c - - + + // The next types are not strictly necessary, but help in understanding what is what. // Used consistently they provide type protection that greatly reduces coding errors @@ -769,7 +779,7 @@ module CommonTypes | invalid -> Decode.fail (sprintf "Invalid case name: %s" invalid)) /// Unique identifier for a fast component. - /// The list is the access path, a list of all the containing custom components + /// The list is the access path, a list of all the containing custom components /// from the top sheet of the simulation (root first) type FComponentId = ComponentId * ComponentId list @@ -854,7 +864,7 @@ module CommonTypes (*-----------------------------------------------------------------------------*) // Types used within waveform Simulation code, and for saved wavesim configuartion - + /// Uniquely identifies a wave by the component it comes from, and the port on which that /// wave is from. Two waves can be identical but have a different index (e.g. a wave with /// PortType Input must be driven by another wave of PortType Output). @@ -866,7 +876,7 @@ module CommonTypes } - + /// Info saved by Wave Sim. @@ -894,14 +904,14 @@ module CommonTypes /// Info regarding sheet saved in the .dgm file type SheetInfo = { - Form: CCForm option + Form: CCForm option Description: string option } (*--------------------------------------------------------------------------------------------------*) /// Static data describing a schematic sheet loaded as a custom component. - /// Every sheet is always identified with a file from which it is loaded/saved. + /// Every sheet is always identified with a file from which it is loaded/saved. /// Name is human readable (and is the filename - without extension) and identifies sheet. /// File path is the sheet directory and name (with extension). /// InputLabels, OutputLabels are the I/O connections. @@ -917,7 +927,7 @@ module CommonTypes /// File name without extension = sheet name Name: string /// When the component was last saved - TimeStamp: System.DateTime + TimeStamp: System.DateTime /// Complete file path, including name and dgm extension FilePath : string /// Info on WaveSim settings @@ -951,9 +961,9 @@ module CommonTypes | Some ldc, _ -> let (comps, _) = ldc.CanvasState List.exists (isClocked (ct.Name :: visitedSheets) ldcs) comps - - + + | DFF | DFFE | Register _ | RegisterE _ | RAM _ | ROM _ | Counter _ |CounterNoEnable _ | CounterNoLoad _ |CounterNoEnableLoad _ -> true @@ -974,20 +984,20 @@ module CommonTypes LoadedComponents : LoadedComponent list } - + let loadedComponents_ = Lens.create (fun a -> a.LoadedComponents) (fun s a -> {a with LoadedComponents = s}) - let openLoadedComponent_ = - Lens.create - (fun a -> List.find (fun lc -> lc.Name = a.OpenFileName) a.LoadedComponents) + let openLoadedComponent_ = + Lens.create + (fun a -> List.find (fun lc -> lc.Name = a.OpenFileName) a.LoadedComponents) (fun lc' a -> {a with LoadedComponents = List.map (fun lc -> if lc.Name = a.OpenFileName then lc' else lc) a.LoadedComponents}) let openFileName_ = Lens.create (fun a -> a.OpenFileName) (fun s a -> {a with OpenFileName = s}) - let loadedComponentOf_ (name:string) = - Lens.create - (fun a -> List.find (fun lc -> lc.Name = name) a.LoadedComponents) + let loadedComponentOf_ (name:string) = + Lens.create + (fun a -> List.find (fun lc -> lc.Name = name) a.LoadedComponents) (fun lc' a -> {a with LoadedComponents = List.map (fun lc -> if lc.Name = name then lc' else lc) a.LoadedComponents}) diff --git a/src/Renderer/Model/ModelType.fs b/src/Renderer/Model/ModelType.fs index 4d73ba134..e913ebfdc 100644 --- a/src/Renderer/Model/ModelType.fs +++ b/src/Renderer/Model/ModelType.fs @@ -53,6 +53,7 @@ type RightTab = | Simulation | Build | Transition // hack to make a transition from Simulation to Catalog without a scrollbar artifact + | DeveloperMode type SimSubTab = | StepSim @@ -77,7 +78,7 @@ type PopupDialogData = { ImportDecisions : Map Int2: int64 option ProjectPath: string - MemorySetup : (int * int * InitMemData * string option) option // AddressWidth, WordWidth. + MemorySetup : (int * int * InitMemData * string option) option // AddressWidth, WordWidth. MemoryEditorData : MemoryEditorData option // For memory editor and viewer. Progress: PopupProgress option ConstraintTypeSel: ConstraintType option @@ -135,7 +136,7 @@ type UICommandType = | StartWaveSim | ViewWaveSim | CloseWaveSim - + //--------------------------------------------------------------- //---------------------WaveSim types----------------------------- //--------------------------------------------------------------- @@ -274,7 +275,7 @@ type SimulationProgress = { InitialClock: int FinalClock: int - ClocksPerChunk: int + ClocksPerChunk: int } type PopupProgress = @@ -344,7 +345,7 @@ type Msg = /// of the given WaveSimModel | GenerateWaveforms of WaveSimModel /// Generate waveforms according to the model paramerts of Wavesim - | GenerateCurrentWaveforms + | GenerateCurrentWaveforms /// Run, or rerun, the FastSimulation with the current state of the Canvas. | RefreshWaveSim of WaveSimModel /// Sets or clears ShowSheetDetail (clearing will remove all child values in the set) @@ -430,6 +431,16 @@ type Msg = | SendSeqMsgAsynch of seq | ContextMenuAction of e: Browser.Types.MouseEvent | ContextMenuItemClick of menuType:string * item:string * dispatch: (Msg -> unit) + /// For Dev Mode to set params + | SelectTracking of bool * ((string list) option) + | ToggleSettingsMenu + | ToggleBeautifyMenu + | ToggleSheetStats + | ToggleSymbolInfoTable + | ToggleSymbolPortsTable + | ToggleWireTable + | ToggleWireSegmentsTable + | ToggleSymbolPortMapsTable //================================// @@ -516,7 +527,7 @@ type Model = { /// If the application has a modal spinner waiting for simulation Spinner: (Model -> Model) option - + /// Draw Canvas Sheet: DrawModelType.SheetT.Model @@ -541,7 +552,7 @@ type Model = { SelectedComponent : Component option // None if no component is selected. /// used during step simulation: simgraph for current clock tick CurrentStepSimulationStep : Result option // None if no simulation is running. - /// stores the generated truth table + /// stores the generated truth table CurrentTruthTable: Result option // None if no Truth Table is being displayed. /// style info for the truth table TTConfig: TTType @@ -552,9 +563,9 @@ type Model = { /// components and connections which are highlighted Hilighted : (ComponentId list * ConnectionId list) * ConnectionId list /// Components and connections that have been selected and copied. - Clipboard : CanvasState + Clipboard : CanvasState /// Track the last added component - LastCreatedComponent : Component option + LastCreatedComponent : Component option /// used to enable "SAVE" button SavedSheetIsOutOfDate : bool /// the project contains, as loadable components, the state of each of its sheets @@ -580,7 +591,19 @@ type Model = { UIState: UICommandType Option /// if true the "build" tab appears on the RHS BuildVisible: bool -} + /// used for developer mode + SettingsMenuExpanded: bool + Tracking: bool + CachedSheetStats: string list option + BeautifyMenuExpanded: bool + SymbolInfoTableExpanded: bool + SymbolPortsTableExpanded: bool + SymbolPortMapsTableExpanded: bool + WireTableExpanded: bool + WireSegmentsTableExpanded: bool + SheetStatsExpanded: bool + +} with member this.WaveSimOrCurrentSheet = match this.WaveSimSheet, this.CurrentProj with diff --git a/src/Renderer/Renderer.fs b/src/Renderer/Renderer.fs index a341686c2..c9db11bd1 100644 --- a/src/Renderer/Renderer.fs +++ b/src/Renderer/Renderer.fs @@ -1,437 +1,437 @@ -(* -Top-level renderer that initialises the app and runs the elmish loop -The electron built-in menus, and key presses,have actions which are -are implemented here using elmish subscriptions -*) - -module Renderer - -open Elmish -open Elmish.React -open Elmish.Debug -open Elmish.HMR -open Fable.Core -open Fable.Core.JsInterop -open ElectronAPI -open ModelType -open Fable.SimpleJson -open JSHelpers -open Sheet.SheetInterface -open DrawModelType -open Optics -open Optics.Operators -open TestParser -open ContextMenus - -importSideEffects "./scss/main.css" - -let isMac = Node.Api.``process``.platform = Node.Base.Darwin - -(**************************************************************************************************** -* -* MENU HELPER FUNCTIONS -* -****************************************************************************************************) - -let menuSeparator = - let sep = createEmpty - sep.``type`` <- Some MenuItemType.Separator - sep - -// Set up window close interlock using IPC from/to main process -let attachExitHandler dispatch = - // set up callback called when attempt is made to close main window - renderer.ipcRenderer.on ("closingWindow", (fun (event: Event)-> - // send a message which will process the request to exit - dispatch <| MenuAction(MenuExit,dispatch) +(* +Top-level renderer that initialises the app and runs the elmish loop +The electron built-in menus, and key presses,have actions which are +are implemented here using elmish subscriptions +*) + +module Renderer + +open Elmish +open Elmish.React +open Elmish.Debug +open Elmish.HMR +open Fable.Core +open Fable.Core.JsInterop +open ElectronAPI +open ModelType +open Fable.SimpleJson +open JSHelpers +open Sheet.SheetInterface +open DrawModelType +open Optics +open Optics.Operators +open TestParser +open ContextMenus + +importSideEffects "./scss/main.css" + +let isMac = Node.Api.``process``.platform = Node.Base.Darwin + +(**************************************************************************************************** +* +* MENU HELPER FUNCTIONS +* +****************************************************************************************************) + +let menuSeparator = + let sep = createEmpty + sep.``type`` <- Some MenuItemType.Separator + sep + +// Set up window close interlock using IPC from/to main process +let attachExitHandler dispatch = + // set up callback called when attempt is made to close main window + renderer.ipcRenderer.on ("closingWindow", (fun (event: Event)-> + // send a message which will process the request to exit + dispatch <| MenuAction(MenuExit,dispatch) )) |> ignore - renderer.ipcRenderer.on ("windowLostFocus", (fun (event: Event)-> - // send a message which will process the request to exit - dispatch <| MenuAction(MenuLostFocus,dispatch) - )) |> ignore -(* -// Set up window close interlock using IPC from/to main process -let attachGetAppHandler dispatch = - // set up callback called when attempt is made to close main window - renderer.ipcRenderer.on ("get-user-data", (fun (event: Event)-> - // send a message which will process the request to exit - dispatch <| SetUserAppDir (unbox event. : string) - )) |> ignore*) - -let getUserAppDir () : string = - unbox <| renderer.ipcRenderer.sendSync("get-user-data",None) - -/// Make action menu item from name, opt key to trigger, and action. -let makeItem (label : string) (accelerator : string option) (iAction : KeyboardEvent -> unit) = - let item = createEmpty - item.label <- Some label - item.accelerator <- accelerator - item.click <- Some (fun _ _ keyEvent -> iAction keyEvent) - item - -/// Make role menu from name, opt key to trigger, and action. -let makeRoleItem label accelerator role = - let item = makeItem label accelerator (fun _ -> ()) - item.role <- Some role - item - -/// make conditional menu item from condition, name, opt key to trigger, and role -let makeCondRoleItem cond label accelerator role = - let item = makeItem label accelerator (fun _ -> ()) - item.role <- Some role - item.visible <- Some cond - item - -/// make a conditional menu item from a condition, -/// name, opt key to trigger, and action -let makeCondItem cond label accelerator action = - let item = makeItem label accelerator action - item.visible <- Some cond - item - -/// A menu item which is visible only if in debug mode -/// (run dev or command line -D on binaries) and on windows. -let makeDebugItem label accelerator option = - makeCondItem (JSHelpers.debugLevel <> 0) label accelerator option - -/// A menu item which is visible only if in debug mode -/// (run dev or command line -D on binaries) and on windows. -let makeWinDebugItem label accelerator option = - makeCondItem (JSHelpers.debugLevel <> 0 && not isMac) label accelerator option - -/// Make -let makeElmItem (label:string) (accelerator : string) (action : unit -> unit) = - jsOptions <| fun item -> - item.label <- Some label - item.accelerator <- Some accelerator - item.click <- Some (fun _ _ _ -> action()) - - -/// Make a new menu from a list of menu items -let makeMenuGen (visible: bool) (topLevel: bool) (name : string) (table : MenuItemConstructorOptions list) = - let subMenu = createEmpty - subMenu.``type`` <- Some (if topLevel then MenuItemType.Normal else MenuItemType.Submenu) - subMenu.label <-Some name - subMenu.submenu <- Some (U2.Case1 (table |> ResizeArray)) - subMenu.visible <- Some visible - subMenu - - -/// Make a new menu from a list of menu items -let makeMenu (topLevel: bool) (name : string) (table : MenuItemConstructorOptions list) = - makeMenuGen true topLevel name table - -open JSHelpers - -let reSeparateWires dispatch = - dispatch <| UpdateModel (fun model -> - model - |> Optic.map (sheet_ >-> SheetT.wire_) (BusWireSeparate.reSeparateWiresFrom model.Sheet.SelectedComponents) - ) - -let reRouteWires dispatch = - dispatch <| UpdateModel (fun model -> - model - |> Optic.map (sheet_ >-> SheetT.wire_) (BusWireSeparate.reRouteWiresFrom model.Sheet.SelectedComponents) - ) - -//-----------------------------------------------------------------------------------------------------------// -//-----------------------------------------------FILE MENU---------------------------------------------------// -//-----------------------------------------------------------------------------------------------------------// - -let fileMenu (dispatch) = - makeMenu false "Sheet" [ - makeItem "New Sheet" (Some "CmdOrCtrl+N") (fun ev -> dispatch (MenuAction(MenuNewFile,dispatch))) - makeItem "Save Sheet" (Some "CmdOrCtrl+S") (fun ev -> dispatch (MenuAction(MenuSaveFile,dispatch))) - makeItem "Save Project in New Format" None (fun ev -> dispatch (MenuAction(MenuSaveProjectInNewFormat,dispatch))) - //makeItem "Print Sheet" (Some "CmdOrCtrl+P") (fun ev -> dispatch (MenuAction(MenuPrint,dispatch))) - makeItem "Write design as Verilog" None (fun ev -> dispatch (MenuAction(MenuVerilogOutput,dispatch))) - makeItem "Exit Issie" None (fun ev -> dispatch (MenuAction(MenuExit,dispatch))) - makeItem ("About Issie " + Version.VersionString) None (fun ev -> UIPopups.viewInfoPopup dispatch) - makeCondRoleItem (debugLevel <> 0 && not isMac) "Hard Restart app" None MenuItemRole.ForceReload - makeWinDebugItem "Trace all" None (fun _ -> - debugTraceUI <- Set.ofList ["update";"view"]) - makeWinDebugItem "Trace View function" None (fun _ -> - debugTraceUI <- Set.ofList ["view"]) - makeWinDebugItem "Trace Update function" None (fun _ -> - debugTraceUI <- Set.ofList ["update"]) - makeWinDebugItem "Trace off" None (fun _ -> - debugTraceUI <- Set.ofList []) - makeMenuGen (debugLevel > 0) false "Play" [ - makeDebugItem "Set Scroll" None - (fun _ -> SheetDisplay.writeCanvasScroll {X=1000.;Y=1000.}) - makeDebugItem "Trace all times" None - (fun _ -> TimeHelpers.instrumentation <- TimeHelpers.ImmediatePrint( 0.1, 0.1) - if debugTraceUI = Set.ofList [] then debugTraceUI <- Set.ofList ["update";"view"]) - makeDebugItem "Trace short, medium & long times" None - (fun _ -> TimeHelpers.instrumentation <- TimeHelpers.ImmediatePrint( 1.5, 1.5) - if debugTraceUI = Set.ofList [] then debugTraceUI <- Set.ofList ["update";"view"]) - makeDebugItem "Trace medium & long times" None - (fun _ -> TimeHelpers.instrumentation <- TimeHelpers.ImmediatePrint(3.,3.) - if debugTraceUI = Set.ofList [] then debugTraceUI <- Set.ofList ["update";"view"]) - makeDebugItem "Trace long times" None - (fun _ -> TimeHelpers.instrumentation <- TimeHelpers.ImmediatePrint(20.,20.) - if debugTraceUI = Set.ofList [] then debugTraceUI <- Set.ofList ["update";"view"]) - makeDebugItem "Highlight debugChangedConnections" None - (fun _ -> Playground.Misc.highLightChangedConnections dispatch) - makeDebugItem "Test Fonts" None - (fun _ -> Playground.TestFonts.makeTextPopup dispatch) - makeWinDebugItem "Run performance check" None - (fun _ -> Playground.MiscTests.testMaps()) - makeWinDebugItem "Print names of static asset files" None - (fun _ -> Playground.MiscTests.testAssets()) - makeWinDebugItem "Test Breadcrumbs" None - (fun _ -> dispatch <| Msg.ExecFuncInMessage(Playground.Breadcrumbs.testBreadcrumbs,dispatch)) - makeWinDebugItem "Test All Hierarchies Breadcrumbs" None - (fun _ -> dispatch <| Msg.ExecFuncInMessage(Playground.Breadcrumbs.testAllHierarchiesBreadcrumbs,dispatch)) - - makeDebugItem "Force Exception" None - (fun ev -> failwithf "User exception from menus") - - makeDebugItem "Web worker performance test" None - (fun _ -> Playground.WebWorker.testWorkers Playground.WebWorker.Constants.workerTestConfig) - - - ] - - makeMenu false "Verilog" [ - makeDebugItem "Run Verilog tests" None (fun _ -> - runCompilerTests () - printfn "Compiler tests done") - makeDebugItem "Run Verilog performance tests" None (fun _ -> - runPerformanceTests () - printfn "Performance tests done") - makeDebugItem "Generate driver modules" None (fun _ -> - genDriverFiles ()) - makeDebugItem "Icarus compile testcases" None (fun _ -> - icarusCompileTestCases ()) - makeDebugItem "Icarus run testcases" None (fun _ -> - icarusRunTestCases ()) - ] - ] - -//-----------------------------------------------------------------------------------------------------------// -//-----------------------------------------------VIEW MENU---------------------------------------------------// -//-----------------------------------------------------------------------------------------------------------// - - -let viewMenu dispatch = - let maindispatch = dispatch - let sheetDispatch sMsg = dispatch (Sheet sMsg) - let dispatch = SheetT.KeyPress >> sheetDispatch - let wireTypeDispatch = SheetT.WireType >> sheetDispatch - let interfaceDispatch = SheetT.IssieInterface >> sheetDispatch - let busWireDispatch (bMsg: BusWireT.Msg) = sheetDispatch (SheetT.Msg.Wire bMsg) - - - - let symbolDispatch msg = busWireDispatch (BusWireT.Msg.Symbol msg) - - let devToolsKey = if isMac then "Alt+Command+I" else "Ctrl+Shift+I" - makeMenu false "View" [ - makeRoleItem "Toggle Fullscreen" (Some "F11") MenuItemRole.Togglefullscreen - menuSeparator - makeRoleItem "Zoom In" (Some "CmdOrCtrl+Shift+Plus") MenuItemRole.ZoomIn - makeRoleItem "Zoom Out" (Some "CmdOrCtrl+Shift+-") MenuItemRole.ZoomOut - makeRoleItem "Reset Zoom" (Some "CmdOrCtrl+0") MenuItemRole.ResetZoom - menuSeparator - makeItem "Diagram Zoom In" (Some "Alt+Up") (fun ev -> dispatch SheetT.KeyboardMsg.ZoomIn) - makeItem "Diagram Zoom Out" (Some "Alt+Down") (fun ev -> dispatch SheetT.KeyboardMsg.ZoomOut) - makeItem "Diagram Zoom to Fit" (Some "CmdOrCtrl+W") (fun ev -> dispatch SheetT.KeyboardMsg.CtrlW) - menuSeparator - makeItem "Toggle Grid" None (fun ev -> sheetDispatch SheetT.Msg.ToggleGrid) - makeMenu false "Theme" [ - makeItem "Grayscale" None (fun ev -> - maindispatch <| SetThemeUserData SymbolT.ThemeType.White - symbolDispatch (SymbolT.Msg.SetTheme SymbolT.ThemeType.White) - ) - makeItem "Light" None (fun ev -> - maindispatch <| SetThemeUserData SymbolT.ThemeType.Light - symbolDispatch (SymbolT.Msg.SetTheme SymbolT.ThemeType.Light) - ) - makeItem "Colourful" None (fun ev -> - maindispatch <| SetThemeUserData SymbolT.ThemeType.Colourful - symbolDispatch (SymbolT.Msg.SetTheme SymbolT.ThemeType.Colourful) - ) - ] - makeItem "Toggle Wire Arrows" None (fun ev -> busWireDispatch (BusWireT.Msg.ToggleArrowDisplay)) - makeMenu false "Wire Type" [ - makeItem "Jump wires" None (fun ev -> wireTypeDispatch SheetT.WireTypeMsg.Jump) - makeItem "Radiussed wires" None (fun ev -> wireTypeDispatch SheetT.WireTypeMsg.Radiussed) - makeItem "Modern wires" None (fun ev -> wireTypeDispatch SheetT.WireTypeMsg.Modern) - ] - menuSeparator - makeItem "Benchmark" (Some "Ctrl+Shift+B") (fun ev -> maindispatch Benchmark) - makeItem "Show/Hide Build Tab" None (fun ev -> maindispatch (ChangeBuildTabVisibility)) - menuSeparator - makeCondItem (JSHelpers.debugLevel <> 0) "Toggle Dev Tools" (Some devToolsKey) (fun _ -> - renderer.ipcRenderer.send("toggle-dev-tools", [||]) |> ignore) - ] - -//-----------------------------------------------------------------------------------------------------------// -//-----------------------------------------------EDIT MENU---------------------------------------------------// -//-----------------------------------------------------------------------------------------------------------// - -// Editor Keybindings (also items on Edit menu) -// Use Elmish subscriptions to attach external source of events such as keyboard -// shortcuts. According to electron documentation, the way to configure keyboard -// shortcuts is by creating a menu. -let editMenu dispatch' = - let sheetDispatch sMsg = dispatch' (Sheet sMsg) - let dispatch = SheetT.KeyPress >> sheetDispatch - let rotateDispatch = SheetT.Rotate >> sheetDispatch - let busWireDispatch (bMsg: BusWireT.Msg) = sheetDispatch (SheetT.Msg.Wire bMsg) - - jsOptions <| fun invisibleMenu -> - invisibleMenu.``type`` <- Some MenuItemType.Submenu - invisibleMenu.label <- Some "Edit" - invisibleMenu.visible <- Some true - invisibleMenu.submenu <- - [| // makeElmItem "Save Sheet" "CmdOrCtrl+S" (fun () -> ()) - makeElmItem "Copy" "CmdOrCtrl+C" (fun () -> dispatch SheetT.KeyboardMsg.CtrlC) - makeElmItem "Paste" "CmdOrCtrl+V" (fun () -> dispatch SheetT.KeyboardMsg.CtrlV) - menuSeparator - makeElmItem "Rotate Anticlockwise" "CmdOrCtrl+Left" (fun () -> rotateDispatch CommonTypes.Degree270) - makeElmItem "Rotate Clockwise" "CmdOrCtrl+Right" (fun () -> rotateDispatch CommonTypes.Degree90) - makeElmItem "Flip Vertically" "CmdOrCtrl+Up" (fun () -> sheetDispatch <| SheetT.Flip SymbolT.FlipVertical) - makeElmItem "Flip Horizontally" "CmdOrCtrl+Down" (fun () -> sheetDispatch <| SheetT.Flip SymbolT.FlipHorizontal) - makeItem "Move Component Ports" None (fun _ -> - dispatch' <| ShowStaticInfoPopup("How to move component ports", SymbolPortHelpers.moveCustomPortsPopup(), dispatch')) - menuSeparator - makeElmItem "Align" "CmdOrCtrl+Shift+A" (fun ev -> sheetDispatch <| SheetT.Arrangement SheetT.AlignSymbols) - makeElmItem "Distribute" "CmdOrCtrl+Shift+D" (fun ev-> sheetDispatch <| SheetT.Arrangement SheetT.DistributeSymbols) - makeElmItem "Rotate Label Clockwise" "CmdOrCtrl+Shift+Right" (fun ev-> sheetDispatch <| SheetT.RotateLabels) - menuSeparator - makeElmItem "Select All" "CmdOrCtrl+A" (fun () -> dispatch SheetT.KeyboardMsg.CtrlA) - makeElmItem "Delete" (if isMac then "Backspace" else "delete") (fun () -> dispatch SheetT.KeyboardMsg.DEL) - makeElmItem "Undo" "CmdOrCtrl+Z" (fun () -> dispatch SheetT.KeyboardMsg.CtrlZ) - makeElmItem "Redo" "CmdOrCtrl+Y" (fun () -> dispatch SheetT.KeyboardMsg.CtrlY) - makeElmItem "Cancel" "ESC" (fun () -> dispatch SheetT.KeyboardMsg.ESC) - menuSeparator - makeItem "Separate Wires from Selected Components" None (fun _ -> reSeparateWires dispatch') - makeItem "Reroute Wires from Selected Components" None (fun _ -> reRouteWires dispatch') - |] - |> ResizeArray - |> U2.Case1 - |> Some - - -let attachMenusAndKeyShortcuts dispatch = - //setupExitInterlock dispatch - let sub dispatch = - let menu:Menu = - [| - - fileMenu dispatch - - editMenu dispatch - - viewMenu dispatch - |] - |> Array.map U2.Case1 - |> electronRemote.Menu.buildFromTemplate //Help? How do we call buildfromtemplate - menu.items[0].visible <- true - dispatch <| Msg.ExecFuncInMessage((fun _ _ -> - electronRemote.app.applicationMenu <- Some menu), dispatch) - attachExitHandler dispatch - let userAppDir = getUserAppDir() - dispatch <| ReadUserData userAppDir - - - Cmd.ofSub sub - -// This setup is useful to add other pages, in case they are needed. - -type Model = ModelType.Model - -type Messages = ModelType.Msg - -// -- Init Model - -let init() = - JSHelpers.setDebugLevel() - DiagramMainView.init(), Cmd.none - - -// -- Create View -let addDebug dispatch (msg:Msg) = - let str = UpdateHelpers.getMessageTraceString msg - //if str <> "" then printfn ">>Dispatch %s" str else () - dispatch msg - -let view model dispatch = DiagramMainView.displayView model (addDebug dispatch) - -// -- Update Model - -let update msg model = Update.update msg model - -printfn "Starting renderer..." - -let view' model dispatch = - let start = TimeHelpers.getTimeMs() - view model dispatch - |> (fun view -> - if Set.contains "view" JSHelpers.debugTraceUI then - TimeHelpers.instrumentInterval ">>>View" start view - else - view) - -let mutable firstPress = true - -///Used to listen for pressing down of Ctrl for selection toggle -let keyPressListener initial = - let subDown dispatch = - Browser.Dom.document.addEventListener("keydown", fun e -> - let ke: KeyboardEvent = downcast e - if (jsToBool ke.ctrlKey || jsToBool ke.metaKey) && firstPress then + renderer.ipcRenderer.on ("windowLostFocus", (fun (event: Event)-> + // send a message which will process the request to exit + dispatch <| MenuAction(MenuLostFocus,dispatch) + )) |> ignore +(* +// Set up window close interlock using IPC from/to main process +let attachGetAppHandler dispatch = + // set up callback called when attempt is made to close main window + renderer.ipcRenderer.on ("get-user-data", (fun (event: Event)-> + // send a message which will process the request to exit + dispatch <| SetUserAppDir (unbox event. : string) + )) |> ignore*) + +let getUserAppDir () : string = + unbox <| renderer.ipcRenderer.sendSync("get-user-data",None) + +/// Make action menu item from name, opt key to trigger, and action. +let makeItem (label : string) (accelerator : string option) (iAction : KeyboardEvent -> unit) = + let item = createEmpty + item.label <- Some label + item.accelerator <- accelerator + item.click <- Some (fun _ _ keyEvent -> iAction keyEvent) + item + +/// Make role menu from name, opt key to trigger, and action. +let makeRoleItem label accelerator role = + let item = makeItem label accelerator (fun _ -> ()) + item.role <- Some role + item + +/// make conditional menu item from condition, name, opt key to trigger, and role +let makeCondRoleItem cond label accelerator role = + let item = makeItem label accelerator (fun _ -> ()) + item.role <- Some role + item.visible <- Some cond + item + +/// make a conditional menu item from a condition, +/// name, opt key to trigger, and action +let makeCondItem cond label accelerator action = + let item = makeItem label accelerator action + item.visible <- Some cond + item + +/// A menu item which is visible only if in debug mode +/// (run dev or command line -D on binaries) and on windows. +let makeDebugItem label accelerator option = + makeCondItem (JSHelpers.debugLevel <> 0) label accelerator option + +/// A menu item which is visible only if in debug mode +/// (run dev or command line -D on binaries) and on windows. +let makeWinDebugItem label accelerator option = + makeCondItem (JSHelpers.debugLevel <> 0 && not isMac) label accelerator option + +/// Make +let makeElmItem (label:string) (accelerator : string) (action : unit -> unit) = + jsOptions <| fun item -> + item.label <- Some label + item.accelerator <- Some accelerator + item.click <- Some (fun _ _ _ -> action()) + + +/// Make a new menu from a list of menu items +let makeMenuGen (visible: bool) (topLevel: bool) (name : string) (table : MenuItemConstructorOptions list) = + let subMenu = createEmpty + subMenu.``type`` <- Some (if topLevel then MenuItemType.Normal else MenuItemType.Submenu) + subMenu.label <-Some name + subMenu.submenu <- Some (U2.Case1 (table |> ResizeArray)) + subMenu.visible <- Some visible + subMenu + + +/// Make a new menu from a list of menu items +let makeMenu (topLevel: bool) (name : string) (table : MenuItemConstructorOptions list) = + makeMenuGen true topLevel name table + +open JSHelpers + +let reSeparateWires dispatch = + dispatch <| UpdateModel (fun model -> + model + |> Optic.map (sheet_ >-> SheetT.wire_) (BusWireSeparate.reSeparateWiresFrom model.Sheet.SelectedComponents) + ) + +let reRouteWires dispatch = + dispatch <| UpdateModel (fun model -> + model + |> Optic.map (sheet_ >-> SheetT.wire_) (BusWireSeparate.reRouteWiresFrom model.Sheet.SelectedComponents) + ) + +//-----------------------------------------------------------------------------------------------------------// +//-----------------------------------------------FILE MENU---------------------------------------------------// +//-----------------------------------------------------------------------------------------------------------// + +let fileMenu (dispatch) = + makeMenu false "Sheet" [ + makeItem "New Sheet" (Some "CmdOrCtrl+N") (fun ev -> dispatch (MenuAction(MenuNewFile,dispatch))) + makeItem "Save Sheet" (Some "CmdOrCtrl+S") (fun ev -> dispatch (MenuAction(MenuSaveFile,dispatch))) + makeItem "Save Project in New Format" None (fun ev -> dispatch (MenuAction(MenuSaveProjectInNewFormat,dispatch))) + //makeItem "Print Sheet" (Some "CmdOrCtrl+P") (fun ev -> dispatch (MenuAction(MenuPrint,dispatch))) + makeItem "Write design as Verilog" None (fun ev -> dispatch (MenuAction(MenuVerilogOutput,dispatch))) + makeItem "Exit Issie" None (fun ev -> dispatch (MenuAction(MenuExit,dispatch))) + makeItem ("About Issie " + Version.VersionString) None (fun ev -> UIPopups.viewInfoPopup dispatch) + makeCondRoleItem (debugLevel <> 0 && not isMac) "Hard Restart app" None MenuItemRole.ForceReload + makeWinDebugItem "Trace all" None (fun _ -> + debugTraceUI <- Set.ofList ["update";"view"]) + makeWinDebugItem "Trace View function" None (fun _ -> + debugTraceUI <- Set.ofList ["view"]) + makeWinDebugItem "Trace Update function" None (fun _ -> + debugTraceUI <- Set.ofList ["update"]) + makeWinDebugItem "Trace off" None (fun _ -> + debugTraceUI <- Set.ofList []) + makeMenuGen (debugLevel > 0) false "Play" [ + makeDebugItem "Set Scroll" None + (fun _ -> SheetDisplay.writeCanvasScroll {X=1000.;Y=1000.}) + makeDebugItem "Trace all times" None + (fun _ -> TimeHelpers.instrumentation <- TimeHelpers.ImmediatePrint( 0.1, 0.1) + if debugTraceUI = Set.ofList [] then debugTraceUI <- Set.ofList ["update";"view"]) + makeDebugItem "Trace short, medium & long times" None + (fun _ -> TimeHelpers.instrumentation <- TimeHelpers.ImmediatePrint( 1.5, 1.5) + if debugTraceUI = Set.ofList [] then debugTraceUI <- Set.ofList ["update";"view"]) + makeDebugItem "Trace medium & long times" None + (fun _ -> TimeHelpers.instrumentation <- TimeHelpers.ImmediatePrint(3.,3.) + if debugTraceUI = Set.ofList [] then debugTraceUI <- Set.ofList ["update";"view"]) + makeDebugItem "Trace long times" None + (fun _ -> TimeHelpers.instrumentation <- TimeHelpers.ImmediatePrint(20.,20.) + if debugTraceUI = Set.ofList [] then debugTraceUI <- Set.ofList ["update";"view"]) + makeDebugItem "Highlight debugChangedConnections" None + (fun _ -> Playground.Misc.highLightChangedConnections dispatch) + makeDebugItem "Test Fonts" None + (fun _ -> Playground.TestFonts.makeTextPopup dispatch) + makeWinDebugItem "Run performance check" None + (fun _ -> Playground.MiscTests.testMaps()) + makeWinDebugItem "Print names of static asset files" None + (fun _ -> Playground.MiscTests.testAssets()) + makeWinDebugItem "Test Breadcrumbs" None + (fun _ -> dispatch <| Msg.ExecFuncInMessage(Playground.Breadcrumbs.testBreadcrumbs,dispatch)) + makeWinDebugItem "Test All Hierarchies Breadcrumbs" None + (fun _ -> dispatch <| Msg.ExecFuncInMessage(Playground.Breadcrumbs.testAllHierarchiesBreadcrumbs,dispatch)) + + makeDebugItem "Force Exception" None + (fun ev -> failwithf "User exception from menus") + + makeDebugItem "Web worker performance test" None + (fun _ -> Playground.WebWorker.testWorkers Playground.WebWorker.Constants.workerTestConfig) + + + ] + + makeMenu false "Verilog" [ + makeDebugItem "Run Verilog tests" None (fun _ -> + runCompilerTests () + printfn "Compiler tests done") + makeDebugItem "Run Verilog performance tests" None (fun _ -> + runPerformanceTests () + printfn "Performance tests done") + makeDebugItem "Generate driver modules" None (fun _ -> + genDriverFiles ()) + makeDebugItem "Icarus compile testcases" None (fun _ -> + icarusCompileTestCases ()) + makeDebugItem "Icarus run testcases" None (fun _ -> + icarusRunTestCases ()) + ] + ] + +//-----------------------------------------------------------------------------------------------------------// +//-----------------------------------------------VIEW MENU---------------------------------------------------// +//-----------------------------------------------------------------------------------------------------------// + + +let viewMenu dispatch = + let maindispatch = dispatch + let sheetDispatch sMsg = dispatch (Sheet sMsg) + let dispatch = SheetT.KeyPress >> sheetDispatch + let wireTypeDispatch = SheetT.WireType >> sheetDispatch + let interfaceDispatch = SheetT.IssieInterface >> sheetDispatch + let busWireDispatch (bMsg: BusWireT.Msg) = sheetDispatch (SheetT.Msg.Wire bMsg) + + + + let symbolDispatch msg = busWireDispatch (BusWireT.Msg.Symbol msg) + + let devToolsKey = if isMac then "Alt+Command+I" else "Ctrl+Shift+I" + makeMenu false "View" [ + makeRoleItem "Toggle Fullscreen" (Some "F11") MenuItemRole.Togglefullscreen + menuSeparator + makeRoleItem "Zoom In" (Some "CmdOrCtrl+Shift+Plus") MenuItemRole.ZoomIn + makeRoleItem "Zoom Out" (Some "CmdOrCtrl+Shift+-") MenuItemRole.ZoomOut + makeRoleItem "Reset Zoom" (Some "CmdOrCtrl+0") MenuItemRole.ResetZoom + menuSeparator + makeItem "Diagram Zoom In" (Some "Alt+Up") (fun ev -> dispatch SheetT.KeyboardMsg.ZoomIn) + makeItem "Diagram Zoom Out" (Some "Alt+Down") (fun ev -> dispatch SheetT.KeyboardMsg.ZoomOut) + makeItem "Diagram Zoom to Fit" (Some "CmdOrCtrl+W") (fun ev -> dispatch SheetT.KeyboardMsg.CtrlW) + menuSeparator + makeItem "Toggle Grid" None (fun ev -> sheetDispatch SheetT.Msg.ToggleGrid) + makeMenu false "Theme" [ + makeItem "Grayscale" None (fun ev -> + maindispatch <| SetThemeUserData SymbolT.ThemeType.White + symbolDispatch (SymbolT.Msg.SetTheme SymbolT.ThemeType.White) + ) + makeItem "Light" None (fun ev -> + maindispatch <| SetThemeUserData SymbolT.ThemeType.Light + symbolDispatch (SymbolT.Msg.SetTheme SymbolT.ThemeType.Light) + ) + makeItem "Colourful" None (fun ev -> + maindispatch <| SetThemeUserData SymbolT.ThemeType.Colourful + symbolDispatch (SymbolT.Msg.SetTheme SymbolT.ThemeType.Colourful) + ) + ] + makeItem "Toggle Wire Arrows" None (fun ev -> busWireDispatch (BusWireT.Msg.ToggleArrowDisplay)) + makeMenu false "Wire Type" [ + makeItem "Jump wires" None (fun ev -> wireTypeDispatch SheetT.WireTypeMsg.Jump) + makeItem "Radiussed wires" None (fun ev -> wireTypeDispatch SheetT.WireTypeMsg.Radiussed) + makeItem "Modern wires" None (fun ev -> wireTypeDispatch SheetT.WireTypeMsg.Modern) + ] + menuSeparator + makeItem "Benchmark" (Some "Ctrl+Shift+B") (fun ev -> maindispatch Benchmark) + makeItem "Show/Hide Build Tab" None (fun ev -> maindispatch (ChangeBuildTabVisibility)) + menuSeparator + makeCondItem (JSHelpers.debugLevel <> 0) "Toggle Dev Tools" (Some devToolsKey) (fun _ -> + renderer.ipcRenderer.send("toggle-dev-tools", [||]) |> ignore) + ] + +//-----------------------------------------------------------------------------------------------------------// +//-----------------------------------------------EDIT MENU---------------------------------------------------// +//-----------------------------------------------------------------------------------------------------------// + +// Editor Keybindings (also items on Edit menu) +// Use Elmish subscriptions to attach external source of events such as keyboard +// shortcuts. According to electron documentation, the way to configure keyboard +// shortcuts is by creating a menu. +let editMenu dispatch' = + let sheetDispatch sMsg = dispatch' (Sheet sMsg) + let dispatch = SheetT.KeyPress >> sheetDispatch + let rotateDispatch = SheetT.Rotate >> sheetDispatch + let busWireDispatch (bMsg: BusWireT.Msg) = sheetDispatch (SheetT.Msg.Wire bMsg) + + jsOptions <| fun invisibleMenu -> + invisibleMenu.``type`` <- Some MenuItemType.Submenu + invisibleMenu.label <- Some "Edit" + invisibleMenu.visible <- Some true + invisibleMenu.submenu <- + [| // makeElmItem "Save Sheet" "CmdOrCtrl+S" (fun () -> ()) + makeElmItem "Copy" "CmdOrCtrl+C" (fun () -> dispatch SheetT.KeyboardMsg.CtrlC) + makeElmItem "Paste" "CmdOrCtrl+V" (fun () -> dispatch SheetT.KeyboardMsg.CtrlV) + menuSeparator + makeElmItem "Rotate Anticlockwise" "CmdOrCtrl+Left" (fun () -> rotateDispatch CommonTypes.Degree270) + makeElmItem "Rotate Clockwise" "CmdOrCtrl+Right" (fun () -> rotateDispatch CommonTypes.Degree90) + makeElmItem "Flip Vertically" "CmdOrCtrl+Up" (fun () -> sheetDispatch <| SheetT.Flip SymbolT.FlipVertical) + makeElmItem "Flip Horizontally" "CmdOrCtrl+Down" (fun () -> sheetDispatch <| SheetT.Flip SymbolT.FlipHorizontal) + makeItem "Move Component Ports" None (fun _ -> + dispatch' <| ShowStaticInfoPopup("How to move component ports", SymbolPortHelpers.moveCustomPortsPopup(), dispatch')) + menuSeparator + makeElmItem "Align" "CmdOrCtrl+Shift+A" (fun ev -> sheetDispatch <| SheetT.Arrangement SheetT.AlignSymbols) + makeElmItem "Distribute" "CmdOrCtrl+Shift+D" (fun ev-> sheetDispatch <| SheetT.Arrangement SheetT.DistributeSymbols) + makeElmItem "Rotate Label Clockwise" "CmdOrCtrl+Shift+Right" (fun ev-> sheetDispatch <| SheetT.RotateLabels) + menuSeparator + makeElmItem "Select All" "CmdOrCtrl+A" (fun () -> dispatch SheetT.KeyboardMsg.CtrlA) + makeElmItem "Delete" (if isMac then "Backspace" else "delete") (fun () -> dispatch SheetT.KeyboardMsg.DEL) + makeElmItem "Undo" "CmdOrCtrl+Z" (fun () -> dispatch SheetT.KeyboardMsg.CtrlZ) + makeElmItem "Redo" "CmdOrCtrl+Y" (fun () -> dispatch SheetT.KeyboardMsg.CtrlY) + makeElmItem "Cancel" "ESC" (fun () -> dispatch SheetT.KeyboardMsg.ESC) + menuSeparator + makeItem "Separate Wires from Selected Components" None (fun _ -> reSeparateWires dispatch') + makeItem "Reroute Wires from Selected Components" None (fun _ -> reRouteWires dispatch') + |] + |> ResizeArray + |> U2.Case1 + |> Some + + +let attachMenusAndKeyShortcuts dispatch = + //setupExitInterlock dispatch + let sub dispatch = + let menu:Menu = + [| + + fileMenu dispatch + + editMenu dispatch + + viewMenu dispatch + |] + |> Array.map U2.Case1 + |> electronRemote.Menu.buildFromTemplate //Help? How do we call buildfromtemplate + menu.items[0].visible <- true + dispatch <| Msg.ExecFuncInMessage((fun _ _ -> + electronRemote.app.applicationMenu <- Some menu), dispatch) + attachExitHandler dispatch + let userAppDir = getUserAppDir() + dispatch <| ReadUserData userAppDir + + + Cmd.ofSub sub + +// This setup is useful to add other pages, in case they are needed. + +type Model = ModelType.Model + +type Messages = ModelType.Msg + +// -- Init Model + +let init() = + JSHelpers.setDebugLevel() + DiagramMainView.init(), Cmd.none + + +// -- Create View +let addDebug dispatch (msg:Msg) = + let str = UpdateHelpers.getMessageTraceString msg + //if str <> "" then printfn ">>Dispatch %s" str else () + dispatch msg + +let view model dispatch = DiagramMainView.displayView model (addDebug dispatch) + +// -- Update Model + +let update msg model = Update.update msg model + +printfn "Starting renderer..." + +let view' model dispatch = + let start = TimeHelpers.getTimeMs() + view model dispatch + |> (fun view -> + if Set.contains "view" JSHelpers.debugTraceUI then + TimeHelpers.instrumentInterval ">>>View" start view + else + view) + +let mutable firstPress = true + +///Used to listen for pressing down of Ctrl for selection toggle +let keyPressListener initial = + let subDown dispatch = + Browser.Dom.document.addEventListener("keydown", fun e -> + let ke: KeyboardEvent = downcast e + if (jsToBool ke.ctrlKey || jsToBool ke.metaKey) && firstPress then firstPress <- false - //printf "Ctrl-Meta Key down (old method)" - dispatch <| Sheet(SheetT.PortMovementStart) - else - ()) - let subUp dispatch = - Browser.Dom.document.addEventListener("keyup", fun e -> + //printf "Ctrl-Meta Key down (old method)" + dispatch <| Sheet(SheetT.PortMovementStart) + else + ()) + let subUp dispatch = + Browser.Dom.document.addEventListener("keyup", fun e -> firstPress <- true - //printf "Any Key up (old method)" - dispatch <| Sheet(SheetT.PortMovementEnd)) - /// unfinished code - /// add hook in main function to display a context menu - /// create menu as shown in main.fs - let subRightClick dispatch = - Browser.Dom.document.addEventListener("contextmenu", unbox (fun (e:Browser.Types.MouseEvent) -> - e.preventDefault() - //printfn "Context Menu listener sending to main..." - dispatch (ContextMenuAction e))) - - - let subContextMenuCommand dispatch = - renderer.ipcRenderer.on("context-menu-command", fun ev args -> - let arg:string = unbox args |> Array.map string |> String.concat "" - printfn "%s" arg - match arg.Split [|','|] |> Array.toList with - | [ menuType ; item ] -> - //printfn "%A" $"Renderer context menu callback: {menuType} --> {item}" - dispatch <| ContextMenuItemClick(menuType,item,dispatch) - | _ -> printfn "Unexpected callback argument sent from main.") |> ignore - - Cmd.batch [ - Cmd.ofSub subDown - Cmd.ofSub subUp - Cmd.ofSub subRightClick - Cmd.ofSub subContextMenuCommand - ] - - - - - - - - - - -Program.mkProgram init update view' -|> Program.withReactBatched "app" -|> Program.withSubscription attachMenusAndKeyShortcuts -|> Program.withSubscription keyPressListener -|> Program.run + //printf "Any Key up (old method)" + dispatch <| Sheet(SheetT.PortMovementEnd)) + /// unfinished code + /// add hook in main function to display a context menu + /// create menu as shown in main.fs + let subRightClick dispatch = + Browser.Dom.document.addEventListener("contextmenu", unbox (fun (e:Browser.Types.MouseEvent) -> + e.preventDefault() + //printfn "Context Menu listener sending to main..." + dispatch (ContextMenuAction e))) + + + let subContextMenuCommand dispatch = + renderer.ipcRenderer.on("context-menu-command", fun ev args -> + let arg:string = unbox args |> Array.map string |> String.concat "" + printfn "%s" arg + match arg.Split [|','|] |> Array.toList with + | [ menuType ; item ] -> + //printfn "%A" $"Renderer context menu callback: {menuType} --> {item}" + dispatch <| ContextMenuItemClick(menuType,item,dispatch) + | _ -> printfn "Unexpected callback argument sent from main.") |> ignore + + Cmd.batch [ + Cmd.ofSub subDown + Cmd.ofSub subUp + Cmd.ofSub subRightClick + Cmd.ofSub subContextMenuCommand + ] + + + + + + + + + + +Program.mkProgram init update view' +|> Program.withReactBatched "app" +|> Program.withSubscription attachMenusAndKeyShortcuts +|> Program.withSubscription keyPressListener +|> Program.run diff --git a/src/Renderer/Renderer.fsproj b/src/Renderer/Renderer.fsproj index aeba094dc..0335df55e 100644 --- a/src/Renderer/Renderer.fsproj +++ b/src/Renderer/Renderer.fsproj @@ -103,6 +103,8 @@ + + diff --git a/src/Renderer/UI/DeveloperModeHelpers.fs b/src/Renderer/UI/DeveloperModeHelpers.fs new file mode 100644 index 000000000..a9a3137a5 --- /dev/null +++ b/src/Renderer/UI/DeveloperModeHelpers.fs @@ -0,0 +1,450 @@ +module DeveloperModeHelpers + +open DrawModelType +open CommonTypes +open DrawModelType.SheetT +open DrawModelType.BusWireT +open Optics +open Helpers +open BlockHelpers +open Symbol +open BusWireRoute +open BusWire +open BusWireUpdateHelpers +open ModelType +open BusWireRoutingHelpers + + +// --------------------------------------------------- // +// Constants // +// --------------------------------------------------- // + +module Constants = + /// Constant that decides if a wire is classified as almost-straight, if its longest segment in the minority direction is shorter than this length + let maxDeviationLengthThresholdAlmostStraight = 30.0 + let maxMinorityDisplacementThreshold = 300 + +open Constants + +// --------------------------------------------------- // +// Helpers // +// --------------------------------------------------- // + +// Return a list of segment lengths with 3 lengths coalesced into 1, if 0.0 length appear, +// otherwise return segment lengths unchanged. +let coalesceWire (wire: Wire) : float list = + let rec coalesceSegLengths (segLengths: float list) = + match segLengths with + | l1 :: 0.0 :: l2 :: rest -> coalesceSegLengths ((l1 + l2) :: rest) + | l :: rest -> l :: (coalesceSegLengths rest) + | [] -> [] + wire.Segments + |> List.map (fun seg -> seg.Length) + |> coalesceSegLengths + +// Take a list of wires and group them into their "nets" (i.e same Output Port). +// Returns a List of nets (where a net = List of wires) +let groupWiresByNet (wireList: Wire list) : Wire list list = + wireList + |> List.groupBy (fun w -> w.OutputPort) // Group wires by same Net + |> List.map snd // Don't need the key in fst, just the wires grouped in snd + + +// Take a sheet and return all Wires on it in a list +let getAllWires (model: SheetT.Model) : Wire list = + model.Wire.Wires |> Map.toList |> List.map snd + + + +/// overlap2DBoxvariant from BlockHelpers. Returns a bounding box of an overlap area between two bounding boxes +// Used in DeveloperModeView +let overlapArea2DBox (bb1: BoundingBox) (bb2: BoundingBox) : BoundingBox option = + let xOverlap = + max + 0.0 + (min (bb1.TopLeft.X + bb1.W) (bb2.TopLeft.X + bb2.W) + - max bb1.TopLeft.X bb2.TopLeft.X) + let yOverlap = + max + 0.0 + (min (bb1.TopLeft.Y + bb1.H) (bb2.TopLeft.Y + bb2.H) + - max bb1.TopLeft.Y bb2.TopLeft.Y) + + if xOverlap > 0.0 && yOverlap > 0.0 then + let overlapTopLeft = + { X = max bb1.TopLeft.X bb2.TopLeft.X; Y = max bb1.TopLeft.Y bb2.TopLeft.Y } + Some { TopLeft = overlapTopLeft; W = xOverlap; H = yOverlap } + else + None + +/// For DeveloperModeView. Similar to countIntersectingSymbolPairs but prints out the boxes that intersect +let countIntersectingSymbolPairsWithOverlapArea (model: SheetT.Model) = + let boxes = + mapValues model.BoundingBoxes + |> Array.toList + |> List.mapi (fun n box -> n, box) + + let bBoxes = + List.allPairs boxes boxes + |> List.filter (fun ((n1, box1), (n2, box2)) -> (n1 < n2) && BlockHelpers.overlap2DBox box1 box2) + |> List.map (fun ((n1, box1), (n2, box2)) -> overlapArea2DBox box1 box2) + |> List.choose id + + bBoxes + // |> List.map (fun box -> printf "Box: %A" box) + |> List.length + + +/// +/// T2R, T3R Helper. +/// Remove all invisible segments from wires on a sheet.Wire.Wires. +/// +/// Map of wires indexed by ConnectionID to remove invisible segments from. +/// Map of wires indexed by ConnectionID with invisible segments removed. +// visibleSegments would've worked, but outputs an XYPos list, which is a format that isn't well accepted by the other functions and types. +// This is achieved by utilising existing helper function segmentsToIssieVertices to convert all segments to a list of vertices. +// It is then very easy to remove duplicate vertices. +// We can utilise another helper function issieVerticesToSegments to convert vertices back to segments, and create new wires. +// ######## +// Important Note!!!: this function should only be used for calculations and not modifying the sheet. This is because it causes all wires to lose their nubs +// (10-length + zero-length) segment pairs, runing a functionality where the wire can no 'grow' additional segments when dragged. +// see BusWireUpdateHelper for more details. If you must use this, the helper function below makeAllWiresDraggable to restore the nubs. +let removeWireInvisibleSegments (wires: Map) = + wires + |> Map.map (fun connId wire -> + let uniqueVertices = + segmentsToIssieVertices wire.Segments wire + |> List.distinctBy (fun (x, y, _) -> (x, y)) + // segmentsToIssieVertices returns list + // get rid of duplicate vertices sharing the same float values + // later, we convert uniqueVertices back to segments + + let newSegments = issieVerticesToSegments connId uniqueVertices + // for each wire, set the segments to the new segments + wire |> Optic.set segments_ newSegments) + +// note: propose name change to team to have removeWireInvisibleSegments above be renamed with 'wires' instead of 'wire', and +// rename removeSingleWireInvisibleSegments to just removeWireInvisibleSegments +let removeSingleWireInvisibleSegments (wire: Wire) = + let uniqueVertices = + segmentsToIssieVertices wire.Segments wire + |> List.distinctBy (fun (x, y, _) -> (x, y)) + let newSegments = issieVerticesToSegments wire.WId uniqueVertices + // for each wire, set the segments to the new segments + wire |> Optic.set segments_ newSegments + +let makeAllWiresDraggable (wires: Map) = + wires + |> Map.map (fun connId wire -> + wire + |> Optic.set segments_ (makeEndsDraggable wire.Segments)) + + +/// +/// Helper function to split a list of segments into odd and even segments +/// Author: tdc21/Tim +/// +let unzipIntoOddAndEvenSegments (segments: Segment list) = + segments + |> List.mapi (fun i x -> (i % 2 = 0, x)) + |> List.partition fst + |> fun (odd, even) -> (List.map snd odd, List.map snd even) + +/// +/// Helper function that checks if a wire is completely straight +/// Author: tdc21/Tim +/// +let checkIfStraightWire (wire: BusWireT.Wire) = + // remove all nubs and invisible segments, should be left with a single segment + let wireWithInvisSegmentsRemoved = (removeSingleWireInvisibleSegments wire) + match wireWithInvisSegmentsRemoved.Segments.Length with + | 1 -> true + | _ -> false + +/// +/// Function that detects if a wire is almost straight. +/// Author: tdc21/Tim +/// +let checkAlmostStraightWire (wire: BusWireT.Wire) (deviationLengthThreshold: float) = + // Get list of even segments and odd segments of the wire. Note: we get rid of invisible segments + let wireWithInvisSegmentsRemoved = (removeSingleWireInvisibleSegments wire) + let oddList, evenList = + wire + |> removeSingleWireInvisibleSegments + |> (fun wire -> unzipIntoOddAndEvenSegments wire.Segments) + let oddDisplacement = + oddList + |> List.sumBy (fun segment -> segment.Length) + let evenDisplacement = + evenList + |> List.sumBy (fun segment -> segment.Length) + + let majorityDisplacement, isWireTravellingInMajority = + // a wire must be initially travelling in its majority direction. + // otherwise, it is not straightenable. See the cases below + + match oddDisplacement >= evenDisplacement, wire.InitialOrientation with + | true, Horizontal -> oddDisplacement, true + | true, Vertical -> oddDisplacement, false + | false, Horizontal -> evenDisplacement, false + | false, Vertical -> evenDisplacement, true + + // can't be straightened if there are less than 2 segments OR segment length is even + if + (wireWithInvisSegmentsRemoved.Segments.Length < 2) + || (wireWithInvisSegmentsRemoved.Segments.Length % 2 = 0) + then + false + else + // maxDeviationLength is the longest segment in the minority direction + // maxMinorityDisplacement is the overall displacement in the minority direction + match wire.InitialOrientation, isWireTravellingInMajority with + | Horizontal, true -> // first seg horiz, majority horiz, will deviate vertically, which will be the even segments + let maxDeviationLength = + (evenList + |> List.maxBy (fun segment -> abs (segment.Length))) + .Length + abs (maxDeviationLength) < deviationLengthThreshold + | Vertical, true -> // first seg vertical, majority vertical, will deviate horizontally, which will be the even segments + let maxDeviationLength = + (evenList + |> List.maxBy (fun segment -> abs (segment.Length))) + .Length + abs (maxDeviationLength) < deviationLengthThreshold + | _, _ -> false + +(* Cases for checkAlmostStraightWire (Not travelling in majority direction) + | ___________ ___________ + ______ | | | No | | + _______| |________ almost straight | | | | | + | _________| |__________ + __________________ | | | No + _______________| almost straight | + + this can be done by checking the length of the list of minority segments + + | | + | | _________ + | ____ ____ | + |_ | | No __________ | + | | almost straight | | | + | | | | No |___________No + | –––– –––– + | | + | | +almost straight + + algo: check whether the wire travels furthest horizontally or vertically. This is the called the majority direction, and the other direction is the minority direction. + + * Not to be confused with the number of segments, e.g. there can be more vertical segments than horizontal segments, but if + the horizontal segments cover a greater displacement, the majority direction is horizontal. + + Next, calculate the majority displacement, which is the sum of the segment lengths in the majority direction. + + After determining majority direction, ake sure the first and last segments are also travelling + in the majority direction. Can be done by checking initialOrientation, and then making sure the length is odd. + Another way to reframe this: any wire (odd segment length) must have an initial orientation that is the same as the majority direction. + (in odd length, first and last segments will be in majority direction) + + If even length, discard, can't straighten a wire that is 'diagonal/L' shaped. Assume no invisible segments since we've removed them + + Then, check for the maximum deviation in the minority direction. If the deviation-to-majority-displacement ratio is less than a certain threshold, then the wire is almost straight. +*) + +// --------------------------------------------------- // +// Metrics for DeveloperModeView // +// --------------------------------------------------- // + +/// T1R: The number of pairs of symbols that intersect each other. See Tick3 for a related function. Count over all pairs of symbols. +/// The model to count the intersecting symbol pairs of. +/// The number of pairs of symbols that intersect each other. +let countIntersectingSymbolPairs (model: SheetT.Model) = + let boxes = + mapValues model.BoundingBoxes + |> Array.toList + |> List.mapi (fun n box -> n, box) + List.allPairs boxes boxes + |> List.filter (fun ((n1, box1), (n2, box2)) -> (n1 < n2) && BlockHelpers.overlap2DBox box1 box2) + |> List.length + + +/// +/// T2R: The number of distinct wire visible segments that intersect with one or more symbols. See Tick3.HLPTick3.visibleSegments for a helper. Count over all visible wire segments. +/// Assumes that within one wire at most one segment crosses a symbol boundary. Not always true, but works for a metric +/// +/// The model to count the intersecting wire segments of. +/// The number of distinct wire visible segments that intersect with one or more symbols. +let countVisibleSegsIntersectingSymbols (model: SheetT.Model) = + + // SheetUpdateHelpers has not implemented updateBoundingBoxes yet on master + let wModel = + model + |> Optic.set boundingBoxes_ (Symbol.getBoundingBoxes model.Wire.Symbol) + |> Optic.map symbols_ (Map.map (fun _ sym -> Symbol.calcLabelBoundingBox sym)) // just in case + |> fun model -> model.Wire + + wModel.Wires + |> Map.values + |> Seq.map (fun wire -> (findWireSymbolIntersections wModel wire)) + |> Seq.sumBy (function + | [] -> 0 + | _ -> 1) + + +/// +/// T3R: The number of distinct pairs of segments that cross each other at right angles. +/// Does not include 0 length segments or segments on same net intersecting at one end, or +/// segments on same net on top of each other. Count over whole sheet. +/// This can be potentially expanded to include more cases by modifying List.filter with more conditions +/// +/// The SheetT.Model to count the right angle crossings of. +/// The number of distinct pairs of segments that cross each other at right angles. +// Corner cases where this won't work: any L shaped crossing that results in a + style configuration, even though wires do not actually cross at right angles +let countVisibleSegsPerpendicularCrossings (model: SheetT.Model) = + let wireMap = removeWireInvisibleSegments model.Wire.Wires // Get all the wires from the Wire model + let wires = Map.toList wireMap + + // Get all the absolute segments from each wire + let segments = + wires + |> List.collect (fun (_, wire) -> + getAbsSegments wire + |> List.map (fun seg -> (wire, seg))) + + // Generate all pairs of segments + let allPairs = + segments + |> List.mapi (fun i seg1 -> + segments + |> List.skip (i + 1) + |> List.map (fun seg2 -> (seg1, seg2))) + |> List.concat + + // Filter the pairs to get only those that belong to wires that do not share the same InputPortId or OutputPortId + // and intersect at a 90º angle + let filteredPairs = + allPairs + |> List.filter (fun ((wire1, seg1), (wire2, seg2)) -> + wire1.InputPort <> wire2.InputPort + && wire1.OutputPort <> wire2.OutputPort + && overlap2D (seg1.Start, seg1.End) (seg2.Start, seg2.End)) + // Return the count of filtered pairs + List.length filteredPairs + +// T4R Author: MHC21 + +// ---- INITIAL FUNCTION : countVisibleSegmentLength ------------------------------------- +// (1) First sort all wires, on the sheet, into their nets giving a "Segment list list list" +// where "a net = Segment list list ". +// (2) List.fold over each net which is fed into a recursive function to find the visible +// segment length of the net. + +// ---- RECURSIVE FUNCTION : netVisibleSegmentLength ------------------------------------- +// (3) The recursive function starts and checks the length of "index 0 Segment" of each +// wire in the net. +// (4.1) As all the "positive length index 0 Segments" overlap, you take the max (or 0 if +// "max < 0") (which is added to running total). +// (4.2) As all the "negative length index 0 Segments" overlap, you take the min (or 0 if +// "min > 0")(which is added to running total). +// (5) Next you need to form the subNets, which is done by grouping wires by their "index +// 0 Segment length", ( Because this length tells you where the "wire split-off" or +// "corner" will occur for the next index (i.e 1) of that wire. If the 2 wires have +// this same length then they will "corner off" at the same point). You then take the +// tail of each wire/Segment List (so only index 1..n of the Segment list). +// (6) Finally you recursively call the function on the subNets which return a float to sum +// to the running total. +// (7) Base case: When subNet only has 1 Wire. Hence just sum the rest of the wire and +// return the float. + +let rec netVisibleSegmentLength (net: Segment list list) : float = + match net.Length with // Number of wires in the net + | 1 -> List.sumBy (fun seg -> abs seg.Length) net[0] // If 1 wire left in subnet, sum rest of the segments in the only wire/subnet + | n -> + let fstSegLengths = List.map (fun (wire: list) -> wire[0].Length) net // Grab first/next segment for each wire in Net/subNet + let longestPosSeg = fstSegLengths |> List.max |> max 0.0 + let longestNegSeg = fstSegLengths |> List.min |> min 0.0 |> abs + let subNets = + net + |> List.groupBy (fun wire -> wire[0].Length) // Group wires into subNets + |> List.map snd // Don't need the length in fst, just the wires grouped in snd + |> List.map (fun wireList -> List.map (fun segList -> List.tail segList) wireList) // Take the tail of each Segment list (1..n) + longestPosSeg + + longestNegSeg + + List.fold (fun totalLength wireList -> totalLength + (netVisibleSegmentLength wireList)) 0.0 subNets + +let countVisibleSegmentLength (model: SheetT.Model) : float = + // Get all wires on sheet and sort them into their "nets" (same InputPort) + // (1) netList = list of nets (2) net = list of wires (3) wire = list of segments + let netList = + model + |> getAllWires + |> groupWiresByNet + |> List.map (fun lst -> List.map (fun (w: Wire) -> w.Segments) lst) + List.fold (fun totalLength wireList -> totalLength + (netVisibleSegmentLength wireList)) 0.0 netList + + +//T5R Author: MHC21 +// ---- INITIAL FUNCTION : countVisibleBends ------------------------------------------- +// (1) First sort all wires, on the sheet, into their nets giving a "float list list list" +// where "a net = float list list ". It's a "float list list" due to the "coalesceWire" +// helper function which converts and coalesces the segments to their lengths. +// (2) List.fold over each net which is fed into a recursive function to find the visible +// segment length of the net. + +// ---- RECURSIVE FUNCTION : netVisibleBends ------------------------------------------- +// (3) The recursive function starts and checks the "index 0 Segment Length" of each wire +// in the net. +// (4) Next you need to form the subNets, which is done by grouping wires by their "index 0 +// Segment Length", ( Because this length tells you where the "wire split-off" or +// "corner" will occur for the next index (i.e 1) of that wire. If the 2 wires have this +// same length then they will "corner off" at the same point). You then take the tail of +// each wire/Segment List (so only index 1..n of the Segment list). +// (5) The length of the subNets (how many subNets/splitOffs/corners made is the number of +// Bends for that iteration). +// (6) Finally you recursively call the function on the subNets which return an int to sum +// to the running total. +// (7) Base case: When subNet only has 1 Wire. Hence just "sum the rest of the Segments of +// the wire" (List.length) and subtract 1 for the rest of the Bends. + +let rec netVisibleBends (net: float list list) : int = + match net.Length with + | 1 -> (List.length net[0]) - 1 + | n -> + let subNets = + net + |> List.groupBy (fun segList -> segList[0]) // Group wires into subNets + |> List.map snd // Don't need the length in fst, just the wires grouped in snd + |> List.map (fun wireList -> List.map (fun segList -> List.tail segList) wireList) // Take the tail of each Segment list (1..n) + + (List.length subNets) + + List.fold (fun totalBends wireList -> totalBends + (netVisibleBends wireList)) 0 subNets + +let countVisibleBends (model: SheetT.Model) : int = + // Get all wires on sheet and sort them into their "nets" (same InputPort) + // (1) netList = list of nets (2) net = list of wires (3) wire = list of floats/lengths + let netList = + model + |> getAllWires + |> groupWiresByNet + |> List.map (fun lst -> List.map (fun w -> coalesceWire w) lst) + List.fold (fun totalBends wireList -> totalBends + (netVisibleBends wireList)) 0 netList + +/// +/// Helper function to count the number of straight wires on a sheet. A heuristic +/// Author: tdc21/Tim +/// +let countStraightWiresOnSheet (sheetModel: SheetT.Model) = + let straightWires = + sheetModel.Wire.Wires + |> Map.filter (fun _ wire -> checkIfStraightWire wire) + straightWires.Count + +/// +/// Function that counts the number of almost straight wires on a sheet. A heuristic to show on DeveloperModeView SheetStats +/// Author: tdc21/Tim +/// +let countAlmostStraightWiresOnSheet (sheetModel: SheetT.Model) = + let straightWires = + sheetModel.Wire.Wires + |> Map.filter (fun _ wire -> checkAlmostStraightWire wire maxDeviationLengthThresholdAlmostStraight) + straightWires.Count diff --git a/src/Renderer/UI/DeveloperModeView.fs b/src/Renderer/UI/DeveloperModeView.fs new file mode 100644 index 000000000..accbd4363 --- /dev/null +++ b/src/Renderer/UI/DeveloperModeView.fs @@ -0,0 +1,515 @@ +module DeveloperModeView + +open EEExtensions +open VerilogTypes +open Fulma + +open Fable.React +open Fable.React.Props + +open JSHelpers +open ModelType +open CommonTypes +open DrawModelType +open DrawModelType.SymbolT +open DrawModelType.BusWireT +open DiagramStyle +open BlockHelpers +open DeveloperModeHelpers +open Symbol +open Optics +open BusWireRoute +open BusWireRoutingHelpers.Constants +open BusWireRoutingHelpers +open Sheet +open DrawModelType.SheetT + + +/// function that returns the an string ID with extra formatting of a hovered wire, symbol, or ports +let findHoveredID (pos: XYPos) (model: SheetT.Model) = + let dummySymbolId: ComponentId = ComponentId "dummy" + // we add a 'dummy symbol' to the model to represent the mouse position + // solely for calculation purposes, it will not be added to the actual model + // for convenience, we let dummy symbol be 30x30, equal to a Not gate size + let h, w = 30.0, 30.0 + let mouseComponentDummy = + { Id = "dummy" + Type = Not + Label = "dummy" + InputPorts = List.empty + OutputPorts = List.empty + X = pos.X - float w / 2.0 + Y = pos.Y - float h / 2.0 + H = float h + W = float w + SymbolInfo = None } + + // create a mouse dummy symbol, find its bounding box, add it to a dummy model + let mouseSymbolDummy: Symbol = + { (createNewSymbol [] pos NotConnected "" White) with + Component = mouseComponentDummy } + let boundingBoxes_ = + Lens.create (fun m -> m.BoundingBoxes) (fun bb m -> { m with BoundingBoxes = bb }) + + let dummyModel = + model + |> Optic.set (SheetT.symbols_) (Map.add dummySymbolId mouseSymbolDummy model.Wire.Symbol.Symbols) + // SheetUpdateHelpers has not implemented updateBoundingBoxes yet on master + |> Optic.set boundingBoxes_ (Symbol.getBoundingBoxes model.Wire.Symbol) + |> Optic.map symbols_ (Map.map (fun _ sym -> Symbol.calcLabelBoundingBox sym)) + // we calculate the bounding box of the mouse + let mouseBoundingBox = getSymbolBoundingBox mouseSymbolDummy + + // inspired by SheetBeautifyD1's findAllBoundingBoxesOfSymIntersections + let intersectingWiresInfo = + dummyModel.Wire.Wires + |> Map.values + // findWireSymbolIntersections returns a list of bounding boxes of symbols intersected by wire. + // we find the wires that have a boundingBox in their intersection list that contains our mouseBoundingBox + // we might get more than one wire – so get a list + + |> Seq.map (fun wire -> (wire, (findWireSymbolIntersections dummyModel.Wire wire))) + |> Seq.choose (fun (wire, bboxes) -> + if + bboxes + |> List.exists (fun box -> + + // findWireSymbolIntersections returns bounding boxes that have been enlarged with minWireSeparation + // we correct this + let correctedBox = + { W = box.W - minWireSeparation * 2. + H = box.H - minWireSeparation * 2. + TopLeft = + box.TopLeft + |> updatePos Right_ minWireSeparation + |> updatePos Down_ minWireSeparation } + mouseBoundingBox =~ correctedBox) + then + Some(wire.WId.ToString()) + + else + None) + |> Seq.toList + |> List.tryHead + + // inspired by SheetBeautifyD1's findAllBoundingBoxesOfSymIntersections + let intersectingSymbolInfo = + model.BoundingBoxes + |> Map.toList + // get all boundingBoxes in model not equal to symbolBoundingBox, see if they overlap with symbolBoundingBox, if yes, return compId + |> List.filter (fun (compId, box) -> not (box =~ mouseBoundingBox)) + |> List.choose (fun (compId, box) -> + match (overlapArea2DBox mouseBoundingBox box) with + | Some area -> Some(compId.ToString()) + | None -> None) + |> List.tryHead + + // inpisred by Sheet.mouseOn + // priority: check for mouse over ports first, then symbols, then wires + // the code for checking for mouse over ports is the same as in Sheet.mouseOn + // otherwise symbol and wire mouseover is calculated based on intersection with mouseBoundingBox + match intersectingWiresInfo, intersectingSymbolInfo with + | _, Some symbolId -> + let inputPorts, outputPorts = + Symbol.getPortLocations model.Wire.Symbol [ ComponentId symbolId ] + |> fun (x, y) -> Map.toList x, Map.toList y + match mouseOnPort inputPorts pos 2.5 with + | Some(portId, portLoc) -> "InputPort: ", portId.ToString() + | None -> + match mouseOnPort outputPorts pos 2.5 with + | Some(portId, portLoc) -> "OutputPort: ", portId.ToString() + | None -> "Symbol: ", symbolId.ToString() + | Some wireId, _ -> "Wire: ", wireId.ToString() + | _ -> "Component: ", "Nothing Selected" + +/// Top Level function for developer mode +let developerModeView (model: ModelType.Model) dispatch = + let sheetDispatch sMsg = dispatch (Sheet sMsg) + + let counterItems = + [ ("Wire-Sym Intersects", (countVisibleSegsIntersectingSymbols model.Sheet).ToString()) + ("Wire-Wire Intersects", (countVisibleSegsPerpendicularCrossings model.Sheet).ToString()) + ("Sym-Sym Intersects", (countIntersectingSymbolPairs model.Sheet).ToString()) + ("90º Degree Wire Bends", (countVisibleBends model.Sheet).ToString()) + ("Near-Straight Wires", (countAlmostStraightWiresOnSheet model.Sheet).ToString()) + ("Straight Wires", (countStraightWiresOnSheet model.Sheet).ToString()) + ("Visible Seg. Length", (countVisibleSegmentLength model.Sheet).ToString("F1")) ] + + let trackingMenuItem trackingMenuName (cachedStringData: (string list) option) dispatch = + Menu.Item.li + [ (Menu.Item.IsActive(model.Tracking)) + Menu.Item.OnClick(fun _ -> + let cachedStringData = + if model.Tracking then + None + else + cachedStringData + dispatch (SelectTracking((not model.Tracking), cachedStringData))) ] + [ strong [] [ str trackingMenuName ] ] + + + /// Some instructions for the user (deprecated) + let instructionText = + div + [ Style [ Margin "15px 0 200px 0" ] ] + [ p [] [ str "Sample Text 1" ] + p [] [ str "Sample Text 2" ] + p [] [ str "Sample Text 3" ] ] + + /// Create a counter item (a title + number) for the sheet stats menu + let createCounterItem title value = + Level.item + [ Level.Item.HasTextCentered ] + [ div + [] + [ Level.heading [] [ str title ] + strong [ Style [ FontSize "17px" ] ] [ str (value) ] ] ] + + /// Create a counter item that is dimmed, for the sheet stats menu + let createCounterItemSaved title value = + Level.item + [ Level.Item.HasTextCentered ] + [ div + [] + [ Level.heading [] [ str title ] + strong [ Style [ FontSize "17px"; Color "#777" ] ] [ str (value) ] ] ] + + let trackerSetting = + let cachedSheetStats = counterItems |> List.map snd + + div + [ Style [ Margin "5px 0 10px 0" ] ] + [ Level.level + [] + [ Level.item + [ Level.Item.HasTextCentered ] + [ div + [ Style [ FontSize "14px"; Width "100%"; Border "1.1px solid #555" ] ] + [ Menu.list [] [ trackingMenuItem "Hold/Unhold Values" (Some cachedSheetStats) dispatch ] ] ] + + ] ] + + /// Create a list of counter items for the sheet stats menu. Can be expanded to include more stats + /// Functions take in a SheetT.Model and output a string/int/float + let counters = + let counterChunks = counterItems |> List.chunkBySize 2 + (counterChunks) + |> List.map (fun counterChunk -> + div + [ Style [ Margin "0 0" ] ] + [ Level.level + [] + (counterChunk + |> List.map (fun (title, value) -> createCounterItem title value)) ]) + |> div [] + + let savedCounters = + match model.CachedSheetStats with + | Some cachedSheetStats -> + let savedCounterItems = + cachedSheetStats + |> List.map2 (fun (title, _) value -> title, value) counterItems + let savedCounterChunks = savedCounterItems |> List.chunkBySize 2 + let savedCounters = + (savedCounterChunks) + |> List.map (fun counterChunk -> + div + [ Style [ Margin "0 0" ] ] + [ Level.level + [] + (counterChunk + |> List.map (fun (title, value) -> createCounterItemSaved title value)) ]) + |> div [] + savedCounters + | None -> div [] [] + + let savedCountersWrapper = + if model.Tracking then + div [ Style [ Background "#f4f4f4"; Padding " 5px" ] ] [ savedCounters ] + else + div [] [] + + /// Stores string details of the currently hovered comp to be used in sheetStatsMenu + let hoveredType, hoveredId = findHoveredID model.Sheet.LastMousePos model.Sheet + + /// Stores the mouse position and hovered component data + let mouseSensitiveData = + div + [ Style [ MarginBottom "20px" ] ] + [ strong [] [ str ("Mouse Position: ") ] + br [] + code + [] + [ str ( + (model.Sheet.LastMousePos.X.ToString("F2")) + + ", " + + (model.Sheet.LastMousePos.Y.ToString("F2")) + ) ] + + br [] + strong [] [ str ("Hovered " + hoveredType) ] + br [] + code [] [ str (hoveredId) ] ] + + /// Contains the mouse position, hovered comp data, and the counters + let sheetStatsMenu = + details + [ Open(model.SheetStatsExpanded) ] + [ summary [ menuLabelStyle; OnClick(fun _ -> dispatch (ToggleSheetStats)) ] [ str "Sheet Stats " ] + div + [] + [ + counters + trackerSetting + savedCountersWrapper ] ] + + /// Function to programmatically generate a html table from PortMaps.Order + let createTableFromPortMapsOrder (map: Map) = + Table.table + [] + (map + |> Map.toList + |> List.map (fun (edge, strList) -> + tr + [] + [ td [] [ str (edge.ToString()) ] + td + [] + (strList + |> List.collect (fun s -> [ code [] [ str ("• " + s) ]; br [] ])) ])) + + /// Function to programmatically generate a html table from a Map PortMaps.Oritentation + let createTableFromPorts (portsMap: Map) (symbol: Symbol) = + let referencePortTable = + // get a list of ports from the selected component. more efficient to search smaller list + // than looking of ports in model.Sheet.Wire.Symbol.Symbols + symbol.Component.InputPorts + @ symbol.Component.OutputPorts + |> List.map (fun port -> port.Id, port) + |> Map.ofList + let portDetailMap = + portsMap + |> Map.map (fun key _ -> Map.tryFind key referencePortTable) + |> Map.filter (fun _ value -> value.IsSome) + |> Map.map (fun _ value -> value.Value) + let tableRows = + portDetailMap + |> Map.toList + |> List.map (fun (key, port) -> + tr + [] + [ td [] [ code [] [ str port.Id ] ] + td + [] + [ str ( + match port.PortNumber with + | Some num -> num.ToString() + | None -> "N/A" + ) ] + td + [] + [ str ( + match port.PortType with + | CommonTypes.PortType.Input -> "In" + | CommonTypes.PortType.Output -> "Out" + ) ] + td [] [ code [] [ str port.HostId ] ] ]) + Table.table + [] + [ tr + [] + [ th [] [ str "Port Id" ] + th [] [ str "No." ] + th [] [ str "I/O" ] + th [] [ str "Host Id" ] ] + yield! tableRows ] + + /// Function to programmatically generate data for a symbol. Includes the symbol's data, its port data, and portmap + let symbolToListItem (model: ModelType.Model) (symbol: Symbol) = + let SymbolTableInfo = + (Table.table + [ Table.IsFullWidth; Table.IsBordered ] + [ tbody + [] + [ tr + [] + [ td [] [ strong [] [ str "Id: " ] ] + td [] [ code [] [ str (symbol.Id.ToString()) ] ] ] + tr + [] + [ td [] [ strong [] [ str "Pos: " ] ] + td + [] + [ str ( + symbol.Pos.X.ToString("F2") + + ", " + + symbol.Pos.Y.ToString("F2") + ) ] ] + tr + [] + [ td [] [ strong [] [ str "Comp. Type: " ] ] + td [] [ code [] [ str (symbol.Component.Type.ToString()) ] ] ] + tr + [] + [ td [] [ strong [] [ str "Comp. Label: " ] ] + td [] [ str (symbol.Component.Label.ToString()) ] ] + tr + [] + [ td [] [ strong [] [ str "Comp. H,W: " ] ] + td + [] + [ str ( + symbol.Component.H.ToString("F2") + + ", " + + symbol.Component.W.ToString("F2") + ) ] ] + tr + [] + [ td [] [ strong [] [ str "STransform: " ] ] + td + [] + [ str ( + "Rotation: " + + symbol.STransform.Rotation.ToString() + ) + br [] + str ("flipped: " + symbol.STransform.flipped.ToString()) ] ] + tr + [] + [ td [] [ strong [] [ str "HScale, VScale: " ] ] + td + [] + [ (match symbol.HScale with + | Some hscale -> str ("HScale: " + hscale.ToString("F2")) + | None -> str "HScale: N/A") + br [] + (match symbol.VScale with + | Some vscale -> str ("VScale: " + vscale.ToString("F2")) + | None -> str "VScale: N/A") ] ] ] ]) + + // expandable menu persists between updates due to the model keeping track of the expanded state. + // this is unlike the Catalogue menu that immediately shuts expandable menu when the user clicks away + [ details + [ Open(model.SymbolInfoTableExpanded) ] + [ summary [ menuLabelStyle; OnClick(fun _ -> dispatch (ToggleSymbolInfoTable)) ] [ str "Symbol " ] + div [] [ SymbolTableInfo ] ] + details + [ Open model.SymbolPortsTableExpanded ] + [ summary [ menuLabelStyle; OnClick(fun _ -> dispatch (ToggleSymbolPortsTable)) ] [ str "Ports" ] + div [] [ (createTableFromPorts symbol.PortMaps.Orientation symbol) ] ] + details + [ Open model.SymbolPortMapsTableExpanded ] + [ summary [ menuLabelStyle; OnClick(fun _ -> dispatch (ToggleSymbolPortMapsTable)) ] [ str "PortMaps" ] + div [] [ (createTableFromPortMapsOrder symbol.PortMaps.Order) ] ] ] + + /// Function to programmatically generate data for a wire. Includes the wire's data and its segments + let wireToListItem (wire: Wire) = + let WireTableInfo = + (Table.table + [ Table.IsFullWidth; Table.IsBordered ] + [ tbody + [] + [ tr + [] + [ td [] [ strong [] [ str "WId: " ] ] + td [] [ code [] [ str (wire.WId.ToString()) ] ] ] + tr + [] + [ td [] [ strong [] [ str "StartPos: " ] ] + td + [] + [ str ( + wire.StartPos.X.ToString("F2") + + ", " + + wire.StartPos.Y.ToString("F2") + ) ] ] + tr + [] + [ td [] [ strong [] [ str "InputPort: " ] ] + td [] [ code [] [ str (wire.InputPort.ToString()) ] ] ] + tr + [] + [ td [] [ strong [] [ str "OutputPort: " ] ] + td [] [ code [] [ str (wire.OutputPort.ToString()) ] ] ] + tr [] [ td [] [ strong [] [ str "Width: " ] ]; td [] [ str (wire.Width.ToString()) ] ] + tr + [] + [ td [] [ strong [] [ str "InitialOrientation: " ] ] + td [] [ str (wire.InitialOrientation.ToString()) ] ] ] ]) + + let createTableFromASegments (segments: ASegment list) = + Table.table + [] + [ tr + [] + [ th [] [ str "Len" ] + th [] [ str "Start" ] + th [] [ str "End" ] + th [] [ str "Drag?" ] + th [] [ str "Route?" ] ] + yield! + segments + |> List.map (fun seg -> + tr + [] + [ td [] [ str (sprintf "%.1f" seg.Segment.Length) ] + td [] [ str (sprintf "%.1f, %.1f" seg.Start.X seg.Start.Y) ] + td [] [ str (sprintf "%.1f, %.1f" seg.End.X seg.End.Y) ] + + td + [] + [ str ( + if seg.Segment.Draggable then + "T" + else + "F" + ) ] + td + [] + [ str ( + match seg.Segment.Mode with + | Manual -> "M" + | Auto -> "A" + ) ] ]) ] + + let absSegments = getAbsSegments wire + let WireSegmentsTableInfo = createTableFromASegments absSegments + + [ details + [ Open model.WireTableExpanded ] + [ summary [ menuLabelStyle; OnClick(fun _ -> dispatch (ToggleWireTable)) ] [ str "Wire " ] + div [] [ WireTableInfo ] ] + details + [ Open model.WireSegmentsTableExpanded ] + [ summary [ menuLabelStyle; OnClick(fun _ -> dispatch (ToggleWireSegmentsTable)) ] [ str "Wire Segments" ] + div [] [ WireSegmentsTableInfo ] ] ] + + /// Code taken from the Properties tab. If nothing is selected, a message is displayed. + let viewComponent = + match model.Sheet.SelectedComponents, model.Sheet.SelectedWires with + | [ compId: ComponentId ], [] -> + let comp = SymbolUpdate.extractComponent model.Sheet.Wire.Symbol compId + let symbol: SymbolT.Symbol = model.Sheet.Wire.Symbol.Symbols[compId] + + div [ Key comp.Id ] [ ul [] (symbolToListItem model symbol) ] + | [], [ wireId: ConnectionId ] -> + let wire = model.Sheet.Wire.Wires.[wireId] + div [ Key(wireId.ToString()) ] [ ul [] (wireToListItem wire) ] + | _ -> + match model.CurrentProj with + | Some proj -> + let sheetName = proj.OpenFileName + let sheetLdc = + proj.LoadedComponents + |> List.find (fun ldc -> ldc.Name = sheetName) + let sheetDescription = sheetLdc.Description + + div + [] + [ p [] [ str "Select a component in the diagram to view its attributes." ] + br [] ] + | None -> null + + /// Top level div for the developer mode view + let viewComponentWrapper = div [] [ p [ menuLabelStyle ] []; viewComponent ] + div [ Style [ Margin "-10px 0 20px 0" ] ] ([ mouseSensitiveData; sheetStatsMenu; viewComponentWrapper ]) diff --git a/src/Renderer/UI/MainView.fs b/src/Renderer/UI/MainView.fs index 785594d85..21995ec91 100644 --- a/src/Renderer/UI/MainView.fs +++ b/src/Renderer/UI/MainView.fs @@ -14,6 +14,7 @@ open Sheet.SheetInterface open DrawModelType open CommonTypes open PopupHelpers +open JSHelpers open Fable.Core open Fable.Core.JsInterop @@ -21,7 +22,6 @@ open Browser.Dom - //------------------Buttons overlaid on Draw2D Diagram----------------------------------// //--------------------------------------------------------------------------------------// @@ -30,20 +30,20 @@ let viewOnDiagramButtons model dispatch = let dispatch = SheetT.KeyPress >> sheetDispatch div [ canvasSmallMenuStyle ] [ - let canvasBut func label = - Button.button [ - Button.Props [ canvasSmallButtonStyle; OnClick func ] + let canvasBut func label = + Button.button [ + Button.Props [ canvasSmallButtonStyle; OnClick func ] Button.Modifiers [ //Modifier.TextWeight TextWeight.Bold Modifier.TextColor IsLight Modifier.BackgroundColor IsSuccess ] - ] + ] [ str label ] - canvasBut (fun _ -> dispatch SheetT.KeyboardMsg.CtrlZ ) "< undo" - canvasBut (fun _ -> dispatch SheetT.KeyboardMsg.CtrlY ) "redo >" - canvasBut (fun _ -> dispatch SheetT.KeyboardMsg.CtrlC ) "copy" - canvasBut (fun _ -> dispatch SheetT.KeyboardMsg.CtrlV ) "paste" + canvasBut (fun _ -> dispatch SheetT.KeyboardMsg.CtrlZ ) "< undo" + canvasBut (fun _ -> dispatch SheetT.KeyboardMsg.CtrlY ) "redo >" + canvasBut (fun _ -> dispatch SheetT.KeyboardMsg.CtrlC ) "copy" + canvasBut (fun _ -> dispatch SheetT.KeyboardMsg.CtrlV ) "paste" ] @@ -122,6 +122,16 @@ let init() = { Pending = [] UIState = None BuildVisible = false + SettingsMenuExpanded = false + Tracking = false + CachedSheetStats = None + BeautifyMenuExpanded = false + SymbolInfoTableExpanded = true + SymbolPortMapsTableExpanded = true + WireTableExpanded = true + WireSegmentsTableExpanded = true + SymbolPortsTableExpanded = true + SheetStatsExpanded = true } @@ -133,7 +143,7 @@ let makeSelectionChangeMsg (model:Model) (dispatch: Msg -> Unit) (ev: 'a) = let viewSimSubTab canvasState model dispatch = match model.SimSubTabVisible with - | StepSim -> + | StepSim -> div [ Style [Width "90%"; MarginLeft "5%"; MarginTop "15px" ] ] [ Heading.h4 [] [ str "Step Simulation" ] SimulationView.viewSimulation canvasState model dispatch @@ -143,7 +153,7 @@ let viewSimSubTab canvasState model dispatch = Heading.h4 [] [ str "Truth Tables" ] TruthTableView.viewTruthTable canvasState model dispatch ] - | WaveSim -> + | WaveSim -> div [ Style [Width "100%"; Height "calc(100% - 72px)"; MarginTop "15px" ] ] [ viewWaveSim canvasState model dispatch ] @@ -152,10 +162,10 @@ let private viewRightTab canvasState model dispatch = let pane = model.RightPaneTabVisible match pane with | Catalogue | Transition -> - + div [ Style [Width "90%"; MarginLeft "5%"; MarginTop "15px" ; Height "calc(100%-100px)"] ] [ Heading.h4 [] [ str "Catalogue" ] - div [ Style [ MarginBottom "15px" ; Height "100%"; OverflowY OverflowOptions.Auto] ] + div [ Style [ MarginBottom "15px" ; Height "100%"; OverflowY OverflowOptions.Auto] ] [ str "Click on a component to add it to the diagram. Hover on components for details." ] CatalogueView.viewCatalogue model dispatch ] @@ -164,15 +174,23 @@ let private viewRightTab canvasState model dispatch = Heading.h4 [] [ str "Component properties" ] SelectedComponentView.viewSelectedComponent model dispatch ] - + | DeveloperMode -> + if debugLevel > 0 then + div + [ Style [ Width "90%"; MarginLeft "5%"; MarginTop "15px" ] ] + [ Heading.h4 [] [ str "Developer Mode" ] + div [ Style [ MarginBottom "15px" ] ] [] + DeveloperModeView.developerModeView model dispatch ] + else + div [] [] | Simulation -> - let subtabs = + let subtabs = Tabs.tabs [ Tabs.IsFullWidth; Tabs.IsBoxed; Tabs.CustomClass "rightSectionTabs"; - Tabs.Props [Style [Margin 0] ] ] - [ + Tabs.Props [Style [Margin 0] ] ] + [ Tabs.tab // step simulation subtab [ Tabs.Tab.IsActive (model.SimSubTabVisible = StepSim) ] - [ a [ OnClick (fun _ -> dispatch <| ChangeSimSubTab StepSim ) ] [str "Step Simulation"] ] + [ a [ OnClick (fun _ -> dispatch <| ChangeSimSubTab StepSim ) ] [str "Step Simulation"] ] (Tabs.tab // truth table tab to display truth table for combinational logic [ Tabs.Tab.IsActive (model.SimSubTabVisible = TruthTable) ] @@ -181,8 +199,10 @@ let private viewRightTab canvasState model dispatch = (Tabs.tab // wavesim tab [ Tabs.Tab.IsActive (model.SimSubTabVisible = WaveSim) ] [ a [ OnClick (fun _ -> dispatch <| ChangeSimSubTab WaveSim) ] [str "Wave Simulation"] ]) + + ] - div [ HTMLAttr.Id "RightSelection2"; Style [Height "100%"]] + div [ HTMLAttr.Id "RightSelection2"; Style [Height "100%"]] [ //br [] // Should there be a gap between tabs and subtabs for clarity? subtabs @@ -197,30 +217,30 @@ let private viewRightTab canvasState model dispatch = /// determine whether moving the mouse drags the bar or not let inline setDragMode (modeIsOn:bool) (model:Model) dispatch = - fun (ev: Browser.Types.MouseEvent) -> + fun (ev: Browser.Types.MouseEvent) -> makeSelectionChangeMsg model dispatch ev //printfn "START X=%d, buttons=%d, mode=%A, width=%A, " (int ev.clientX) (int ev.buttons) model.DragMode model.ViewerWidth match modeIsOn, model.DividerDragMode with - | true, DragModeOff -> + | true, DragModeOff -> dispatch <| SetDragMode (DragModeOn (int ev.clientX)) - | false, DragModeOn _ -> + | false, DragModeOn _ -> dispatch <| SetDragMode DragModeOff | _ -> () /// Draggable vertivcal bar used to divide Wavesim window from Diagram window let dividerbar (model:Model) dispatch = - let isDraggable = - model.RightPaneTabVisible = Simulation - && (model.SimSubTabVisible = WaveSim + let isDraggable = + model.RightPaneTabVisible = Simulation + && (model.SimSubTabVisible = WaveSim || model.SimSubTabVisible = TruthTable) - let heightAttr = + let heightAttr = let rightSection = document.getElementById "RightSection" if (isNull rightSection) then Height "100%" else Height "100%" //rightSection.scrollHeight - let variableStyle = + let variableStyle = if isDraggable then [ BackgroundColor "grey" - Cursor "ew-resize" + Cursor "ew-resize" Width Constants.dividerBarWidth ] else [ @@ -235,56 +255,65 @@ let dividerbar (model:Model) dispatch = ] div [ Style <| commonStyle @ variableStyle - OnMouseDown (setDragMode true model dispatch) + OnMouseDown (setDragMode true model dispatch) ] [] let viewRightTabs canvasState model dispatch = /// Hack to avoid scrollbar artifact changing from Simulation to Catalog - /// The problem is that the HTML is bistable - with Y scrollbar on the catalog