Add code to display and step through access views.
This commit is contained in:
parent
672d321616
commit
844888b28c
|
@ -15,3 +15,5 @@ type Msg
|
||||||
| DeleteRawModel Int
|
| DeleteRawModel Int
|
||||||
| UseHierarchy (Maybe CacheModelHierarchy)
|
| UseHierarchy (Maybe CacheModelHierarchy)
|
||||||
| Access Int
|
| Access Int
|
||||||
|
| AccessViewForward
|
||||||
|
| AccessViewBack
|
||||||
|
|
|
@ -41,8 +41,31 @@ updateUseHierarchy cmh m =
|
||||||
updateAccess : Int -> Model -> (Model, Cmd Msg)
|
updateAccess : Int -> Model -> (Model, Cmd Msg)
|
||||||
updateAccess i m =
|
updateAccess i m =
|
||||||
let
|
let
|
||||||
accessResult = Maybe.map (accessCacheHierarchy i) m.hierarchy
|
accessResult = Maybe.andThen (Result.toMaybe << accessCacheHierarchy i) m.hierarchy
|
||||||
newModel = m
|
newModel = { m | accessView = Maybe.map (\ar -> (ar, Down 0)) accessResult }
|
||||||
|
cmd = Cmd.none
|
||||||
|
in
|
||||||
|
(newModel, cmd)
|
||||||
|
|
||||||
|
updateAccessViewForward : Model -> (Model, Cmd Msg)
|
||||||
|
updateAccessViewForward m =
|
||||||
|
let
|
||||||
|
afterStep = Maybe.map accessViewForward m.accessView
|
||||||
|
replaceHierarchy avs h = List.map .output avs ++ List.drop (List.length avs) h
|
||||||
|
(newHierarchy, newAccessView) =
|
||||||
|
case afterStep of
|
||||||
|
Just (avs, Done) -> (Maybe.map (replaceHierarchy avs) m.hierarchy, Nothing)
|
||||||
|
as_ -> (m.hierarchy, as_)
|
||||||
|
newModel = { m | accessView = newAccessView, hierarchy = newHierarchy }
|
||||||
|
cmd = Cmd.none
|
||||||
|
in
|
||||||
|
(newModel, cmd)
|
||||||
|
|
||||||
|
updateAccessViewBack : Model -> (Model, Cmd Msg)
|
||||||
|
updateAccessViewBack m =
|
||||||
|
let
|
||||||
|
afterStep = Maybe.map accessViewBack m.accessView
|
||||||
|
newModel = { m | accessView = afterStep }
|
||||||
cmd = Cmd.none
|
cmd = Cmd.none
|
||||||
in
|
in
|
||||||
(newModel, cmd)
|
(newModel, cmd)
|
||||||
|
|
|
@ -2,6 +2,7 @@ module CacheSim.View exposing (..)
|
||||||
import CacheSim.Raw exposing (..)
|
import CacheSim.Raw exposing (..)
|
||||||
import CacheSim.Model exposing (..)
|
import CacheSim.Model exposing (..)
|
||||||
import CacheSim.Cache exposing (..)
|
import CacheSim.Cache exposing (..)
|
||||||
|
import CacheSim.AccessView exposing (..)
|
||||||
import CacheSim.Hierarchy exposing (..)
|
import CacheSim.Hierarchy exposing (..)
|
||||||
import Html exposing (Html, input, text, div, label, span, h2, h3, table, tr, td)
|
import Html exposing (Html, input, text, div, label, span, h2, h3, table, tr, td)
|
||||||
import Html.Attributes exposing (type_, class, value, for, classList, disabled, colspan)
|
import Html.Attributes exposing (type_, class, value, for, classList, disabled, colspan)
|
||||||
|
@ -126,6 +127,21 @@ viewCacheHierarchy ch =
|
||||||
, levels
|
, levels
|
||||||
]
|
]
|
||||||
|
|
||||||
|
viewAccessView : Model -> AccessView -> Html Msg
|
||||||
|
viewAccessView m av =
|
||||||
|
let
|
||||||
|
currentCache = Maybe.withDefault [] m.hierarchy
|
||||||
|
in
|
||||||
|
div [ class "access-view" ]
|
||||||
|
[ buttonWrapper
|
||||||
|
[ button "Forward" AccessViewForward
|
||||||
|
, button "Back" AccessViewBack
|
||||||
|
]
|
||||||
|
, viewCacheHierarchy <| effectiveCacheHierarchy currentCache av
|
||||||
|
]
|
||||||
|
|
||||||
|
viewAccessInput : Html Msg
|
||||||
|
viewAccessInput = input [ type_ "button", onClick (Access 128), value "Access me" ] []
|
||||||
|
|
||||||
viewError : Bool -> String -> Html Msg
|
viewError : Bool -> String -> Html Msg
|
||||||
viewError hide e = span [ classList [ ("hidden", hide) ] ] [ text e ]
|
viewError hide e = span [ classList [ ("hidden", hide) ] ] [ text e ]
|
||||||
|
@ -135,5 +151,6 @@ viewBase m =
|
||||||
let
|
let
|
||||||
rawView = viewRawCacheModelHierarchy m.rawHierarchy
|
rawView = viewRawCacheModelHierarchy m.rawHierarchy
|
||||||
cacheView = Maybe.withDefault [] <| Maybe.map (List.singleton << viewCacheHierarchy) <| m.hierarchy
|
cacheView = Maybe.withDefault [] <| Maybe.map (List.singleton << viewCacheHierarchy) <| m.hierarchy
|
||||||
|
accessView = Maybe.withDefault [] <| Maybe.map (List.singleton << viewAccessView m) <| m.accessView
|
||||||
in
|
in
|
||||||
div [] <| [ rawView ] ++ cacheView
|
div [] <| [ rawView, viewAccessInput] ++ cacheView ++ accessView
|
||||||
|
|
|
@ -37,6 +37,8 @@ update msg m =
|
||||||
DeleteRawModel i -> updateDeleteRawModel i m
|
DeleteRawModel i -> updateDeleteRawModel i m
|
||||||
UseHierarchy cmh -> updateUseHierarchy cmh m
|
UseHierarchy cmh -> updateUseHierarchy cmh m
|
||||||
Access i -> updateAccess i m
|
Access i -> updateAccess i m
|
||||||
|
AccessViewForward -> updateAccessViewForward m
|
||||||
|
AccessViewBack -> updateAccessViewBack m
|
||||||
|
|
||||||
subscriptions : Model -> Sub Msg
|
subscriptions : Model -> Sub Msg
|
||||||
subscriptions m = Sub.none
|
subscriptions m = Sub.none
|
||||||
|
|
Loading…
Reference in New Issue
Block a user