Added ability to load example from server

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"

out/css/colors-light.css

@@ -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 );
 }
 
 

out/css/style.css

@@ -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 {

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,24 +501,33 @@ 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.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
@@ -473,10 +540,13 @@ decodeModel text =
                 (JD.field "accumulator" JD.int)
             ) 
         )
-            ( JD.field "uCode" (JD.list uCodeDecoder) )
-            ( JD.field "autoscroll" JD.bool )
+        ( JD.field "uCode" 
+            <| JD.list 
+            <| JD.map (\s -> Maybe.withDefault ActNothing <| string2uAction s ) 
+            <| JD.string
         )
-    |> error2maybe
+        ( JD.field "autoscroll" JD.bool )
+
 
 cmdUpdateLocalStorage : Model -> Cmd Msg
 cmdUpdateLocalStorage 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