From b61cafd947ce8f2e5ac075cd83c5b9e1a7e98b0f Mon Sep 17 00:00:00 2001 From: Tom Clarke Date: Tue, 5 Sep 2023 00:12:06 +0100 Subject: [PATCH] improve breadcrumbs, info make breadcrumbs configurable to allow duplicate instances or not. Show hierarchy without duplicated Show hierarchy using components currently in draw block Update info page --- src/Renderer/UI/Breadcrumbs.fs | 22 ++++++++++++++++++---- src/Renderer/UI/FileMenuHelpers.fs | 4 ++-- src/Renderer/UI/FileMenuView.fs | 10 ++++++---- src/Renderer/UI/ModelHelpers.fs | 8 ++++++++ src/Renderer/UI/UIPopups.fs | 19 +++++++++---------- src/Renderer/UI/UpdateHelpers.fs | 2 +- 6 files changed, 44 insertions(+), 21 deletions(-) diff --git a/src/Renderer/UI/Breadcrumbs.fs b/src/Renderer/UI/Breadcrumbs.fs index 0f246d2ab..d8456a165 100644 --- a/src/Renderer/UI/Breadcrumbs.fs +++ b/src/Renderer/UI/Breadcrumbs.fs @@ -19,6 +19,7 @@ open Optics.Optic *) type BreadcrumbConfig = { + AllowDuplicateSheets: bool BreadcrumbIdPrefix: string ColorFun: SheetTree -> IColor ClickAction: SheetTree -> (Msg -> unit) -> unit @@ -38,6 +39,7 @@ module Constants = Padding "50px"] let defaultConfig = { + AllowDuplicateSheets = false BreadcrumbIdPrefix = "BreadcrumbDefault" ColorFun = fun _ -> IColor.IsGreyDark ClickAction = fun _ _ -> () @@ -172,7 +174,7 @@ let hierarchyBreadcrumbs (model: Model) = mapOverProject (div [] []) model (fun p -> let root = Option.defaultValue p.OpenFileName model.WaveSimSheet - let sheetTreeMap = getSheetTrees p + let sheetTreeMap = getSheetTrees cfg.AllowDuplicateSheets p makeBreadcrumbsFromPositions sheetTreeMap cfg (positionDesignHierarchyInGrid root) dispatch) @@ -187,7 +189,7 @@ let hierarchyFromSheetBreadcrumbs (dispatch: Msg -> unit) (model: Model) = mapOverProject (div [] []) model (fun p -> - let sheetTreeMap = getSheetTrees p + let sheetTreeMap = getSheetTrees cfg.AllowDuplicateSheets p makeBreadcrumbsFromPositions sheetTreeMap cfg (positionDesignHierarchyInGrid rootSheet) dispatch) /// Breadcrumbs of entire design hierarchy of every root sheet in project @@ -199,7 +201,7 @@ let allRootHierarchiesFromProjectBreadcrumbs (dispatch: Msg -> unit) (model: Model) = mapOverProject ([div [] []]) model (fun p -> - let sheetTreeMap = getSheetTrees p + let sheetTreeMap = getSheetTrees cfg.AllowDuplicateSheets p allRootSheets sheetTreeMap |> Set.toList |> List.map (fun root -> @@ -209,6 +211,18 @@ let allRootHierarchiesFromProjectBreadcrumbs ] [ td [CellSpacing "50px"] [el]]) |> fun rows -> table [] [tbody [] rows] +/// is there a duplicate sheet name anywhere in hierarchy? +let hierarchiesHaveDuplicates (model: Model) = + mapOverProject false model (fun p -> + getSheetTrees true p + |> Map.toList + |> List.map (fun (_,sheet) -> + let sheetNames = + sheet.SubSheets + |> List.map (fun sheet -> sheet.SheetName) + sheetNames.Length = (List.distinct sheetNames).Length) + |> List.exists id) + /// Breadcrumbs of the focus sheet, with sheets on its path to root, and its children. /// Provides navigation while occupying small vertical area. Untested. @@ -225,6 +239,6 @@ let smallSimulationBreadcrumbs (model: Model) : ReactElement = mapOverProject (div [] []) model (fun p -> - makeBreadcrumbsFromPositions (getSheetTrees p) cfg (positionRootAndFocusChildrenInGrid rootName pathToFocus) dispatch) + makeBreadcrumbsFromPositions (getSheetTrees cfg.AllowDuplicateSheets p) cfg (positionRootAndFocusChildrenInGrid rootName pathToFocus) dispatch) diff --git a/src/Renderer/UI/FileMenuHelpers.fs b/src/Renderer/UI/FileMenuHelpers.fs index 5c44a3037..5972214bf 100644 --- a/src/Renderer/UI/FileMenuHelpers.fs +++ b/src/Renderer/UI/FileMenuHelpers.fs @@ -299,7 +299,7 @@ let rec foldOverTree (isSubSheet: bool) (folder: bool -> SheetTree -> Model -> M /// Get the subsheet tree for all sheets in the current project. /// Returns a map from sheet name to tree of SheetTree nodes -let getSheetTrees (p:Project): Map = +let getSheetTrees (allowAllInstances: bool) (p:Project): Map = let ldcMap = p.LoadedComponents |> List.map (fun ldc -> ldc.Name,ldc) @@ -338,7 +338,7 @@ let getSheetTrees (p:Project): Map = |> fun l -> 0 :: l |> List.max Size = List.sumBy (fun sub -> sub.Size) subs + 1; - SubSheets = subs + SubSheets = if allowAllInstances then subs else (subs |> List.distinctBy (fun sh -> sh.SheetName)) GridArea = None }) |> makeBreadcrumbNamesUnique diff --git a/src/Renderer/UI/FileMenuView.fs b/src/Renderer/UI/FileMenuView.fs index 0622da734..25f5e2a2e 100644 --- a/src/Renderer/UI/FileMenuView.fs +++ b/src/Renderer/UI/FileMenuView.fs @@ -1139,9 +1139,11 @@ let viewTopMenu model dispatch = let fileTab model = match model.CurrentProj with | None -> Navbar.Item.div [] [] - | Some project -> + | Some project -> + let updatedProject = getUpdatedLoadedComponents project model + let updatedModel = {model with CurrentProj = Some updatedProject} - let sTrees = getSheetTrees project + let sTrees = getSheetTrees false updatedProject let allRoots = allRootSheets sTrees let isSubSheet sh = not <| Set.contains sh allRoots @@ -1155,7 +1157,7 @@ let viewTopMenu model dispatch = openFileInProject (sheet.SheetName) p model dispatch), dispatch) let sheetColor (sheet:SheetTree) = - match sheet.SheetName = project.OpenFileName, sheetIsLocked sheet.SheetName model with + match sheet.SheetName = project.OpenFileName, sheetIsLocked sheet.SheetName updatedModel with | true, true -> IColor.IsCustomColor "pink" | true, false -> IColor.IsCustomColor "lightslategrey" | false, true -> IColor.IsDanger @@ -1170,7 +1172,7 @@ let viewTopMenu model dispatch = let breadcrumbs = [ div [Style [TextAlign TextAlignOptions.Center; FontSize "15px"]] [str "Sheets with Design Hierarchy"] - Breadcrumbs.allRootHierarchiesFromProjectBreadcrumbs breadcrumbConfig dispatch model + Breadcrumbs.allRootHierarchiesFromProjectBreadcrumbs breadcrumbConfig dispatch updatedModel ] Navbar.Item.div diff --git a/src/Renderer/UI/ModelHelpers.fs b/src/Renderer/UI/ModelHelpers.fs index 6b8222ef7..01648c440 100644 --- a/src/Renderer/UI/ModelHelpers.fs +++ b/src/Renderer/UI/ModelHelpers.fs @@ -3,6 +3,8 @@ open CommonTypes open Sheet.SheetInterface open ModelType open Elmish +open Optics +open Optics.Operators module Constants = @@ -329,3 +331,9 @@ let execOneAsyncJobIfPossible (model: Model,cmd: Cmd)= job.JobWork model |> (fun (model', cmd') -> model', Cmd.batch [cmd; cmd']) +/// Return the project with with open file contents in loadedcomponents updated according to +/// current Draw Block contents. +let getUpdatedLoadedComponents (project: Project) (model: Model) : Project = + mapOverProject project model ( fun p -> + p + |> Optic.set (loadedComponentOf_ p.OpenFileName >-> canvasState_) (model.Sheet.GetCanvasState())) diff --git a/src/Renderer/UI/UIPopups.fs b/src/Renderer/UI/UIPopups.fs index 013c0729b..5b58df86c 100644 --- a/src/Renderer/UI/UIPopups.fs +++ b/src/Renderer/UI/UIPopups.fs @@ -140,15 +140,14 @@ let viewInfoPopup dispatch = ] let intro = div [] [ - str "Issie designs are hierarchical, made of one main sheet and optional subsheets. Include the hardware defined on one sheet in another - by adding a 'custom component' from the 'My Project' section of the Catalog. \ - Top-level sheets which are not used as subsheets are bolded on the sheet menu." + str "Issie designs are hierarchical, made of one main sheet and optional subsheets. Include the hardware defined on one sheet in another \ + by adding any number of 'custom components' from the 'My Project' section of the Catalog. The Sheet menu shows the hierarchy." br []; br [] - str "Issie supports step simulation for all circuits, and waveform simulation to view the waveforms of clocked circuits. + str "Issie supports step simulation for all circuits, and waveform simulation to view the waveforms of clocked circuits. \ Use whichever works for you." br []; br []; - str "In Issie all clocked components use the same clock signal Clk. \ - Clk connections are not shown: all Clk ports are + str "In Issie all clocked components (blue fill) use the same clock signal Clk. \ + Clk connections are not shown: all Clk ports are \ automatically connected together. In the waveform display active clock edges, 1 per clock cycle, are indicated \ by vertical lines through the waveforms." br [] ; br []; @@ -161,8 +160,8 @@ let viewInfoPopup dispatch = Table.table [] [ tbody [] [ tr [] [ - td [] [str "Left-Click Menus"] - td [] [str "Explore the Left-Click Menus to find context-dependent operations"] + td [] [str "Right-Click Menus"] + td [] [str "Explore the Right-Click Menus to find context-dependent operations"] ] tr [] [ @@ -249,7 +248,7 @@ let viewInfoPopup dispatch = let keyOf3 s1 s2 s3 = span [] [bSpan s1; tSpan " + "; bSpan s2 ; tSpan " + "; bSpan s3] let rule = hr [Style [MarginTop "0.5em"; MarginBottom "0.5em"]] let keys = div [] [ - makeH "Keyboard & mouse gesture shortcuts - also available on top menus and left-click context menus" + makeH "Keyboard & mouse gesture shortcuts - also available on top menus and right-click context menus" span [Style [FontStyle "Italic"]] [str "On Mac use Cmd instead of Ctrl."] ul [] [ li [] [rule; tSpan "Save: "; keyOf2 "Ctrl" "S"; rule] @@ -258,7 +257,7 @@ let viewInfoPopup dispatch = li [] [tSpan "Paste diagram items: " ; keyOf2 "Ctrl" "V"; rule] li [] [tSpan "Undo last diagram action: " ; keyOf2 "Ctrl" "Z"] li [] [tSpan "Redo last diagram action: " ; keyOf2 "Ctrl" "Y"; rule] - li [] [tSpan "Zoom application in: " ; keyOf3 "Ctrl" "Shift" "="] + li [] [tSpan "Zoom application in: " ; keyOf3 "Ctrl" "Shift" "+"] li [] [tSpan "Zoom application out: " ; keyOf3 "Ctrl" "Shift" "-"; rule] li [] [tSpan "Zoom canvas in/out: " ; keyOf2 "Ctrl" "MouseWheel"] li [] [tSpan "Zoom canvas in: " ; keyOf2 "Alt" "Up"] diff --git a/src/Renderer/UI/UpdateHelpers.fs b/src/Renderer/UI/UpdateHelpers.fs index 396e02b16..a7b3ee05b 100644 --- a/src/Renderer/UI/UpdateHelpers.fs +++ b/src/Renderer/UI/UpdateHelpers.fs @@ -303,7 +303,7 @@ let getContextMenu (e: Browser.Types.MouseEvent) (model: Model) : string = //printfn "NameParts: %A"nameParts model.CurrentProj |> Option.map (fun p -> - Map.tryFind nameParts[1] (getSheetTrees p) + Map.tryFind nameParts[1] (getSheetTrees false p) |> Option.map ( fun sheet -> SheetMenuBreadcrumb (sheet, nameParts.Length > 2))) |> Option.flatten