Added ability to load example from server
This commit is contained in:
parent
1701a5ea08
commit
0aa08315d1
3
elm.json
3
elm.json
@ -9,9 +9,12 @@
|
||||
"elm/browser": "1.0.2",
|
||||
"elm/core": "1.0.5",
|
||||
"elm/html": "1.0.0",
|
||||
"elm/http": "2.0.0",
|
||||
"elm/json": "1.1.3"
|
||||
},
|
||||
"indirect": {
|
||||
"elm/bytes": "1.0.8",
|
||||
"elm/file": "1.0.5",
|
||||
"elm/time": "1.0.0",
|
||||
"elm/url": "1.0.0",
|
||||
"elm/virtual-dom": "1.0.2"
|
||||
|
||||
@ -89,6 +89,10 @@
|
||||
--color-arrow-text: var(--color-white);
|
||||
--color-arrow-text-hover: var(--color-white-light2);
|
||||
--color-arrow-border: var(--color-black-light1);
|
||||
|
||||
--color-modal: var(--color-white-light1);
|
||||
--color-modal-text: var(--color-black);
|
||||
--color-modal-shadow: rgba( 0,0,0, 0.4 );
|
||||
}
|
||||
|
||||
|
||||
|
||||
@ -162,6 +162,10 @@ button {
|
||||
margin-bottom: -1em;
|
||||
}
|
||||
|
||||
.pc .scroller table {
|
||||
margin: 0;
|
||||
}
|
||||
|
||||
.pc .scroller table thead.head {
|
||||
position: sticky;
|
||||
top: -2px;
|
||||
@ -508,6 +512,62 @@ th.address {
|
||||
}
|
||||
|
||||
|
||||
/* MODALS */
|
||||
.modal {
|
||||
position: fixed;
|
||||
top: 0;
|
||||
left: 0;
|
||||
z-index: 1000;
|
||||
|
||||
box-sizing: border-box;
|
||||
width: 100vw;
|
||||
height: 100vh;
|
||||
|
||||
display: flex;
|
||||
align-items: center;
|
||||
justify-content: center;
|
||||
}
|
||||
.modal.hidden {
|
||||
display: none;
|
||||
}
|
||||
|
||||
.modal-card {
|
||||
z-index: 1500;
|
||||
display: block;
|
||||
width: 40em;
|
||||
min-width: 45vw;
|
||||
min-height: 5em;
|
||||
position: relative;
|
||||
box-sizing: border-box;
|
||||
|
||||
padding: 2.5em 2em 1em 2em;
|
||||
|
||||
background-color: var(--color-modal);
|
||||
color: var(--color-modal-text);
|
||||
}
|
||||
|
||||
.modal > :first-child {
|
||||
position: fixed;
|
||||
top: 0;
|
||||
left: 0;
|
||||
width: 100%;
|
||||
height: 100%;
|
||||
|
||||
background-color: var(--color-modal-shadow);
|
||||
}
|
||||
|
||||
.modal .modal-close {
|
||||
position: absolute;
|
||||
top: .5em;
|
||||
right: .5em;
|
||||
|
||||
}
|
||||
|
||||
.modal .modal-close::before {
|
||||
content: "❌";
|
||||
}
|
||||
|
||||
|
||||
|
||||
/* HELPERS */
|
||||
.text-center {
|
||||
|
||||
1522
out/elm.js
1522
out/elm.js
File diff suppressed because it is too large
Load Diff
199
src/Main.elm
199
src/Main.elm
@ -14,8 +14,10 @@ import Html exposing (address)
|
||||
import Json.Encode as JE
|
||||
import Json.Decode as JD
|
||||
import Html.Events exposing (targetValue)
|
||||
import Http
|
||||
|
||||
modelVersion = 1
|
||||
examplesListUrl = "examples-list.json"
|
||||
|
||||
-- Note that general Stuff is at the end of the document
|
||||
-- PORTS
|
||||
@ -45,8 +47,21 @@ type alias Model =
|
||||
{ pc : PC
|
||||
, uCode : List UAction
|
||||
, autoscroll : Bool
|
||||
, examples : List Example
|
||||
, exampleChooserOpen : Bool
|
||||
, examplesListStatus : LoaderState
|
||||
, exampleLoaderStatus : LoaderState
|
||||
}
|
||||
|
||||
type alias Example =
|
||||
{ title : String
|
||||
, version : String
|
||||
, url : String
|
||||
, enabled : Bool
|
||||
}
|
||||
|
||||
type LoaderState = Failure String | Waiting | Success
|
||||
|
||||
|
||||
type UAction
|
||||
= ActAccumulator2DataBus
|
||||
@ -64,7 +79,6 @@ type UAction
|
||||
| ActProgrammCounter2AddressBus
|
||||
| ActNothing
|
||||
|
||||
|
||||
uCodeDescriptions : List ( UAction, String )
|
||||
uCodeDescriptions =
|
||||
[ ( ActAccumulator2DataBus, "Acc -> DataBus" )
|
||||
@ -230,6 +244,11 @@ type Msg
|
||||
| MsgAluEdit String
|
||||
| MsgLocalSessionExport
|
||||
| MsgLocalSessionRecieve String
|
||||
| MsgToggleLoadExample
|
||||
| MsgLoadExamplesList
|
||||
| MsgLoadExample Int
|
||||
| MsgLoadExampleArrived (Result Http.Error Model)
|
||||
| MsgExamplesArrived (Result Http.Error (List Example))
|
||||
|
||||
|
||||
update : Msg -> Model -> ( Model, Cmd Msg )
|
||||
@ -361,11 +380,50 @@ update msg model =
|
||||
( model, cmdUpdateLocalStorage model )
|
||||
|
||||
MsgLocalSessionRecieve message_in ->
|
||||
case decodeModel message_in of
|
||||
case decodeModel model message_in of
|
||||
Just new_model ->
|
||||
( new_model , Cmd.none )
|
||||
( { new_model | examples = model.examples } , Cmd.none )
|
||||
_ -> ( model, Cmd.none )
|
||||
|
||||
MsgToggleLoadExample ->
|
||||
if model.exampleChooserOpen then
|
||||
( { model | exampleChooserOpen = False }
|
||||
, Cmd.none )
|
||||
else
|
||||
( { model | exampleChooserOpen = True }
|
||||
, cmdLoadExamples model)
|
||||
|
||||
|
||||
MsgLoadExamplesList ->
|
||||
( model, Cmd.none )
|
||||
|
||||
MsgLoadExample i ->
|
||||
case valueAt i model.examples of
|
||||
Just example ->
|
||||
({ model | exampleChooserOpen = False }
|
||||
, cmdLoadExampleSing model example )
|
||||
Nothing ->
|
||||
( model, Cmd.none )
|
||||
|
||||
MsgLoadExampleArrived result ->
|
||||
case result of
|
||||
Ok new_model ->
|
||||
updateModel { model | pc = new_model.pc
|
||||
, uCode = new_model.uCode
|
||||
, exampleLoaderStatus = Success }
|
||||
Err err ->
|
||||
( { model | exampleLoaderStatus = Failure <| httpError2String err }
|
||||
, Cmd.none )
|
||||
|
||||
|
||||
MsgExamplesArrived result ->
|
||||
case result of
|
||||
Ok exampleList ->
|
||||
( { model | examples = exampleList, examplesListStatus = Success }
|
||||
, Cmd.none )
|
||||
Err err ->
|
||||
( { model | examplesListStatus = Failure <| httpError2String err }
|
||||
, Cmd.none )
|
||||
|
||||
|
||||
-- Practically a part of uStepPC but sepeated for manual mode
|
||||
@ -443,41 +501,53 @@ encodeModel model =
|
||||
]
|
||||
|> JE.encode 0
|
||||
|
||||
|
||||
decodeModel : String -> Maybe Model
|
||||
decodeModel text =
|
||||
decodeModel : Model -> String -> Maybe Model
|
||||
decodeModel model text =
|
||||
let
|
||||
error2maybe err =
|
||||
case err of
|
||||
Ok val -> Just val
|
||||
_ -> Nothing
|
||||
|
||||
uCodeDecoder =
|
||||
JD.map
|
||||
(\s -> Maybe.withDefault ActNothing <| string2uAction s )
|
||||
(JD.string)
|
||||
in
|
||||
text
|
||||
|> JD.decodeString
|
||||
( JD.map3
|
||||
Model
|
||||
( JD.field "pc"
|
||||
( JD.map7
|
||||
PC
|
||||
(JD.field "ram" (JD.list JD.int))
|
||||
(JD.field "dataBus" JD.int)
|
||||
(JD.field "addressBus" JD.int)
|
||||
(JD.field "instructionReg" JD.int)
|
||||
(JD.field "programmCounter" JD.int)
|
||||
(JD.field "uCounter" JD.int)
|
||||
(JD.field "accumulator" JD.int)
|
||||
)
|
||||
)
|
||||
( JD.field "uCode" (JD.list uCodeDecoder) )
|
||||
( JD.field "autoscroll" JD.bool )
|
||||
)
|
||||
|> JD.decodeString modelDecoder
|
||||
|> error2maybe
|
||||
|
||||
exampleListDecoder : JD.Decoder (List Example)
|
||||
exampleListDecoder =
|
||||
JD.field "available"
|
||||
<| JD.list
|
||||
<| JD.map4
|
||||
Example
|
||||
( JD.field "title" JD.string )
|
||||
( JD.field "version" JD.string )
|
||||
( JD.field "url" JD.string )
|
||||
( JD.field "enabled" (JD.map (\s -> s == 1) JD.int) )
|
||||
|
||||
modelDecoder : JD.Decoder Model
|
||||
modelDecoder =
|
||||
JD.map3
|
||||
(\a b c -> Model a b c [] False Waiting Waiting)
|
||||
( JD.field "pc"
|
||||
( JD.map7
|
||||
PC
|
||||
(JD.field "ram" (JD.list JD.int))
|
||||
(JD.field "dataBus" JD.int)
|
||||
(JD.field "addressBus" JD.int)
|
||||
(JD.field "instructionReg" JD.int)
|
||||
(JD.field "programmCounter" JD.int)
|
||||
(JD.field "uCounter" JD.int)
|
||||
(JD.field "accumulator" JD.int)
|
||||
)
|
||||
)
|
||||
( JD.field "uCode"
|
||||
<| JD.list
|
||||
<| JD.map (\s -> Maybe.withDefault ActNothing <| string2uAction s )
|
||||
<| JD.string
|
||||
)
|
||||
( JD.field "autoscroll" JD.bool )
|
||||
|
||||
|
||||
cmdUpdateLocalStorage : Model -> Cmd Msg
|
||||
cmdUpdateLocalStorage model =
|
||||
localStorageSend (encodeModel model)
|
||||
@ -489,6 +559,30 @@ cmdSenduUpdate model =
|
||||
, sendUUpdate "update"
|
||||
]
|
||||
|
||||
|
||||
cmdLoadExamples : Model -> Cmd Msg
|
||||
cmdLoadExamples model =
|
||||
Http.get
|
||||
{ url = examplesListUrl
|
||||
, expect = Http.expectJson MsgExamplesArrived exampleListDecoder
|
||||
}
|
||||
|
||||
cmdLoadExampleSing : Model -> Example -> Cmd Msg
|
||||
cmdLoadExampleSing model example =
|
||||
Http.get
|
||||
{ url = example.url
|
||||
, expect = Http.expectJson MsgLoadExampleArrived modelDecoder
|
||||
}
|
||||
|
||||
httpError2String : Http.Error -> String
|
||||
httpError2String err =
|
||||
case err of
|
||||
Http.BadUrl str -> "Bad Url: " ++ str
|
||||
Http.Timeout -> "Timeout"
|
||||
Http.NetworkError -> "Network Error"
|
||||
Http.BadStatus num -> "Bad Status: " ++ String.fromInt num
|
||||
Http.BadBody str -> "Bad Body: " ++ str
|
||||
|
||||
-- VIEWERS
|
||||
|
||||
view : Model -> Html Msg
|
||||
@ -523,12 +617,15 @@ viewPC model =
|
||||
[ text "Autoscroll" ]
|
||||
]
|
||||
, button [ onClick MsgLocalSessionExport ] [ text "Export" ]
|
||||
, button [ onClick MsgToggleLoadExample ] [ text "Load Example" ]
|
||||
]
|
||||
, div [ class "grid-fullwidth" ] [ lazy viewAddressBus model ]
|
||||
, lazy viewRam model
|
||||
, lazy viewCu model
|
||||
, lazy viewAlu model
|
||||
, div [ class "grid-fullwidth" ] [ lazy viewDataBus model ]
|
||||
, lazy viewExamples model
|
||||
, lazy viewExamplesLoaderError model
|
||||
]
|
||||
|
||||
|
||||
@ -800,8 +897,50 @@ viewInstrEntry i =
|
||||
text ( (addLeadingZero instruction 3) ++ " " ++ (addLeadingZero address 5) )
|
||||
|
||||
|
||||
viewExamples : Model -> Html Msg
|
||||
viewExamples model =
|
||||
div [ classList [("modal", True), ("hidden", (not model.exampleChooserOpen))] ]
|
||||
[ div [] []
|
||||
, div [ class "modal-card" ]
|
||||
[ Html.a [ class "modal-close", onClick MsgToggleLoadExample ] []
|
||||
, lazy viewExamplesEntrys model
|
||||
]
|
||||
]
|
||||
|
||||
viewExamplesEntrys : Model -> Html Msg
|
||||
viewExamplesEntrys model =
|
||||
let
|
||||
entry2html (id, example) =
|
||||
Html.tr []
|
||||
[ Html.td [] [ text <| "Example: " ++ example.title ]
|
||||
, Html.td [] [ button [ onClick <| MsgLoadExample id ] [ text "Laden" ] ]
|
||||
]
|
||||
in
|
||||
case model.examplesListStatus of
|
||||
Failure msg ->
|
||||
div [] [ text <| "That didn't work: " ++ msg]
|
||||
Waiting ->
|
||||
div [] [ text "Loading..." ]
|
||||
Success ->
|
||||
div [ class "scroller" ]
|
||||
[ Html.table []
|
||||
<| List.map entry2html
|
||||
<| List.indexedMap Tuple.pair model.examples
|
||||
]
|
||||
|
||||
|
||||
viewExamplesLoaderError : Model -> Html Msg
|
||||
viewExamplesLoaderError model =
|
||||
case model.exampleLoaderStatus of
|
||||
Failure msg ->
|
||||
div [ class "modal" ]
|
||||
[ div [] []
|
||||
, div [ class "modal-card" ]
|
||||
[ Html.p [] [ text "Something didn't work. Please refresh the page"]
|
||||
, Html.p [] [ text msg ]
|
||||
]
|
||||
]
|
||||
_ -> text ""
|
||||
|
||||
-- END VIEWERS
|
||||
-- ACTIONS
|
||||
@ -1013,7 +1152,7 @@ subscriptions model =
|
||||
|
||||
init : () -> ( Model, Cmd Msg )
|
||||
init flags =
|
||||
( Model initialPC initialUCodes True, Cmd.none )
|
||||
( Model initialPC initialUCodes True [] False Waiting Waiting, Cmd.none )
|
||||
|
||||
|
||||
main : Program () Model Msg
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user