diff --git a/src/CacheSim/Model.elm b/src/CacheSim/Model.elm index 3bc3a1d..efb6a4b 100644 --- a/src/CacheSim/Model.elm +++ b/src/CacheSim/Model.elm @@ -15,3 +15,5 @@ type Msg | DeleteRawModel Int | UseHierarchy (Maybe CacheModelHierarchy) | Access Int + | AccessViewForward + | AccessViewBack diff --git a/src/CacheSim/Update.elm b/src/CacheSim/Update.elm index 110736a..f53db4e 100644 --- a/src/CacheSim/Update.elm +++ b/src/CacheSim/Update.elm @@ -41,8 +41,31 @@ updateUseHierarchy cmh m = updateAccess : Int -> Model -> (Model, Cmd Msg) updateAccess i m = let - accessResult = Maybe.map (accessCacheHierarchy i) m.hierarchy - newModel = m + accessResult = Maybe.andThen (Result.toMaybe << accessCacheHierarchy i) m.hierarchy + 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 in (newModel, cmd) diff --git a/src/CacheSim/View.elm b/src/CacheSim/View.elm index f8a6b3a..71fd3a5 100644 --- a/src/CacheSim/View.elm +++ b/src/CacheSim/View.elm @@ -2,6 +2,7 @@ module CacheSim.View exposing (..) import CacheSim.Raw exposing (..) import CacheSim.Model exposing (..) import CacheSim.Cache exposing (..) +import CacheSim.AccessView exposing (..) import CacheSim.Hierarchy exposing (..) 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) @@ -126,6 +127,21 @@ viewCacheHierarchy ch = , 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 hide e = span [ classList [ ("hidden", hide) ] ] [ text e ] @@ -135,5 +151,6 @@ viewBase m = let rawView = viewRawCacheModelHierarchy m.rawHierarchy cacheView = Maybe.withDefault [] <| Maybe.map (List.singleton << viewCacheHierarchy) <| m.hierarchy + accessView = Maybe.withDefault [] <| Maybe.map (List.singleton << viewAccessView m) <| m.accessView in - div [] <| [ rawView ] ++ cacheView + div [] <| [ rawView, viewAccessInput] ++ cacheView ++ accessView diff --git a/src/Main.elm b/src/Main.elm index 0f83b95..8f3f694 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -37,6 +37,8 @@ update msg m = DeleteRawModel i -> updateDeleteRawModel i m UseHierarchy cmh -> updateUseHierarchy cmh m Access i -> updateAccess i m + AccessViewForward -> updateAccessViewForward m + AccessViewBack -> updateAccessViewBack m subscriptions : Model -> Sub Msg subscriptions m = Sub.none