Compare commits

..

2 Commits

5 changed files with 28 additions and 8 deletions

View File

@ -17,5 +17,6 @@ type Msg
| UseHierarchy (Maybe CacheModelHierarchy) | UseHierarchy (Maybe CacheModelHierarchy)
| Access (List Int) | Access (List Int)
| ChangeAccessInput String | ChangeAccessInput String
| AccessViewCancel
| AccessViewForward | AccessViewForward
| AccessViewBack | AccessViewBack

View File

@ -60,6 +60,14 @@ updateAccess li m =
in in
(newModel, cmd) (newModel, cmd)
updateAccessViewCancel : Model -> (Model, Cmd Msg)
updateAccessViewCancel m =
let
newModel = { m | accessView = Nothing }
cmd = Cmd.none
in
(newModel, cmd)
updateAccessViewForward : Model -> (Model, Cmd Msg) updateAccessViewForward : Model -> (Model, Cmd Msg)
updateAccessViewForward m = updateAccessViewForward m =
let let

View File

@ -22,6 +22,9 @@ disabledButton attrs = button (attrs ++ [ disabled True ])
dangerButton : String -> Msg -> Html Msg dangerButton : String -> Msg -> Html Msg
dangerButton s m = button [ onClick m, class "btn-danger" ] s dangerButton s m = button [ onClick m, class "btn-danger" ] s
infoButton : String -> Msg -> Html Msg
infoButton s m = button [ onClick m, class "btn-info" ] s
primaryButton : String -> Msg -> Html Msg primaryButton : String -> Msg -> Html Msg
primaryButton s m = button [ onClick m, class "btn-primary" ] s primaryButton s m = button [ onClick m, class "btn-primary" ] s
@ -39,7 +42,10 @@ resultButton = maybeButton << Result.toMaybe
-- Button wrapper (button group) -- Button wrapper (button group)
buttonWrapper : List (Html Msg) -> Html Msg buttonWrapper : List (Html Msg) -> Html Msg
buttonWrapper = div [ classList [("btn-group", True), ("mb-3", True) ] ] buttonWrapper = div [ classList [("btn-group", True), ("mb-3", True), ("mr-3", True) ] ]
buttonToolbar : List (List (Html Msg)) -> Html Msg
buttonToolbar ll = div [ class "btn-toolbar" ] <| List.map buttonWrapper ll
-- Input with a label -- Input with a label
labeledInput : String -> String -> (String -> Msg) -> Html Msg labeledInput : String -> String -> (String -> Msg) -> Html Msg
@ -102,8 +108,8 @@ viewRawCacheModelHierarchy rcmh =
Ok _ -> viewError True "" Ok _ -> viewError True ""
Err e -> viewError False e Err e -> viewError False e
newButton = primaryButton "Add level" CreateRawModel newButton = infoButton "Add level" CreateRawModel
useButton = resultButton checkedResult [ class "btn-primary" ] "Start simulation" (UseHierarchy << Just) useButton = resultButton checkedResult [ class "btn-info" ] "Start simulation" (UseHierarchy << Just)
in in
div [] div []
[ h2 [] [ text "Cache hierarchy" ] [ h2 [] [ text "Cache hierarchy" ]
@ -163,9 +169,9 @@ viewAccessView m av =
div [] div []
[ h2 [] [ text "Access Simulation" ] [ h2 [] [ text "Access Simulation" ]
, p [] [ text ("Simulating access of address " ++ String.fromInt av.blockAddr) ] , p [] [ text ("Simulating access of address " ++ String.fromInt av.blockAddr) ]
, buttonWrapper , buttonToolbar
[ primaryButton "Back" AccessViewBack [ [ infoButton "Back" AccessViewBack, infoButton "Forward" AccessViewForward ]
, primaryButton "Forward" AccessViewForward , [ dangerButton "Stop" AccessViewCancel ]
] ]
, h3 [] [ text "Access event log" ] , h3 [] [ text "Access event log" ]
, viewAccessLog av , viewAccessLog av
@ -216,12 +222,12 @@ viewAccessInput m =
case parseResult of case parseResult of
Ok is -> if is == [] then Err "Please enter at least one number." else Ok is Ok is -> if is == [] then Err "Please enter at least one number." else Ok is
Err e -> Err <| parseErrorToString e Err e -> Err <| parseErrorToString e
accessButton = resultButton checkedResult [ class "btn-primary" ] "Access address" Access accessButton = resultButton checkedResult [ class "btn-info" ] "Access address" Access
errorHtml = errorHtml =
case checkedResult of case checkedResult of
Ok _ -> viewError True "" Ok _ -> viewError True ""
Err e -> viewError False e Err e -> viewError False e
editHierarchyButton = secondaryButton "Edit hierarchy" (UseHierarchy Nothing) editHierarchyButton = button [ onClick (UseHierarchy Nothing), class "btn-dark" ] "Edit hierarchy"
in in
div [] div []
[ h2 [] [ text "Run access simulation" ] [ h2 [] [ text "Run access simulation" ]

View File

@ -35,6 +35,7 @@ update msg m =
UseHierarchy cmh -> updateUseHierarchy cmh m UseHierarchy cmh -> updateUseHierarchy cmh m
Access i -> updateAccess i m Access i -> updateAccess i m
ChangeAccessInput s -> ({ m | accessInput = s }, Cmd.none) ChangeAccessInput s -> ({ m | accessInput = s }, Cmd.none)
AccessViewCancel -> updateAccessViewCancel m
AccessViewForward -> updateAccessViewForward m AccessViewForward -> updateAccessViewForward m
AccessViewBack -> updateAccessViewBack m AccessViewBack -> updateAccessViewBack m

View File

@ -1,3 +1,7 @@
.btn-group { .btn-group {
width: min-content; width: min-content;
} }
.btn:focus {
box-shadow: none;
}