Implemented Im- and Export by user

src/Main.elm

@@ -4,9 +4,9 @@
 port module Main exposing (..)
 
 import Browser
-import Html                         exposing (Html, button, div, h1, p, text)
+import Html                         exposing (Html, Attribute, button, div, h1, p, text)
 import Html.Attributes  as HAttr    exposing (class, classList, value)
-import Html.Events      as HEvent   exposing (onClick, onInput)
+import Html.Events      as HEvent   exposing (onClick, onInput, preventDefaultOn)
 import Html.Lazy                    exposing (lazy)
 import Tuple
 import Array                        exposing (get)
@@ -16,6 +16,13 @@ import Json.Decode      as JD
 --import Html.Events exposing (targetValue)
 import Http
 
+-- DragDrop
+import Task
+import Process
+import File                         exposing (File)
+import File.Select      as Select
+import File.Download    as Download
+
 import PC.Types                     exposing (..)
 import PC.PC            as PC  
 import PC.Json          
@@ -28,36 +35,47 @@ examplesListUrl = "examples-list.json"
 -- ####################################################
 -- PORTS
 -- ####################################################
-port sendUUpdate : String -> Cmd msg
+port sendUUpdate        : String -> Cmd msg
-port localStorageSend : String -> Cmd msg
+port localStorageSend   : String -> Cmd msg
+port sendProcessing     : String -> Cmd msg
 
 
 -- #####################################################################
 -- #####################################################################
 
 type alias Model =
-    { pc_model : PC_Model
+    { pc_model              : PC_Model
-    , autoscroll : Bool
+    , autoscroll            : Bool
-    , examples : List Example
+    , examples              : List Example
-    , exampleChooserOpen : Bool
+    , exampleChooserOpen    : Bool
-    , examplesListStatus : LoaderState
+    , examplesListStatus    : LoaderState
-    , exampleLoaderStatus : LoaderState
+    , exampleLoaderStatus   : LoaderState
+    , dragDrop              : DragDrop
     }
 
 type alias Example =
-    { title : String
+    { title                 : String
-    , version : String
+    , version               : String
-    , url : String
+    , url                   : String
-    , enabled : Bool
+    , enabled               : Bool
     }
 
-type LoaderState = Failure String | Waiting | Success
+type alias DragDrop =
+    { hover                 : Bool
+    , state                 : DragDropState
+    , file                  : Maybe File
+    , fileContent           : Maybe String
+    }
+
+type DragDropState  = DS_Ready | DS_Processing | DS_Sucess | DS_Failure
+type LoaderState    = Failure String | Waiting | Success
 
 -- #####################################################################
 -- Update
 -- #####################################################################
 
 -- DEsmpl = Dialog Examples
+-- DrgDrp = DragDrop
 type Msg
     = Msg_PC                        PC_Msg
     | Msg_Autoscroll_Toggle
@@ -65,10 +83,18 @@ type Msg
     | Msg_DEsmpl_EClick             Int
     | Msg_DEsmpl_ExampleLoaded      (Result Http.Error Model)
     | Msg_DEsmpl_ListLoaded         (Result Http.Error (List Example))
+    | Msg_DEsmpl_Download
+    | Msg_DEsmpl_Upload
+    | Msg_DrgDrp_Hover              Bool
+    | Msg_DrgDrp_GotFiles           File (List File)
+    | Msg_DrgDrp_DecodedFiles       String
 
 
 update : Msg -> Model -> ( Model, Cmd Msg )
 update msg model =
+    let
+        old_dragDrop = model.dragDrop
+    in
     case msg of
         Msg_PC pc_msg ->            -- PC is updated
             let
@@ -148,6 +174,75 @@ update msg model =
                     ( { model | examplesListStatus = Failure <| printHttpError err }
                     , Cmd.none )
 
+        Msg_DEsmpl_Download ->
+            ( model
+            , Download.string 
+                "johnny-export.json" 
+                "application/json" 
+                <| doEncodeModel model
+            )
+        
+        Msg_DEsmpl_Upload ->
+            ( model
+            , Select.files ["application/json"] Msg_DrgDrp_GotFiles
+            )
+
+        Msg_DrgDrp_Hover new_hover ->
+            ( { model | dragDrop = {old_dragDrop | hover = new_hover, state = DS_Ready } }
+            , Cmd.none
+            )
+
+        Msg_DrgDrp_GotFiles file _ ->
+            if File.size file > 10000 then
+                -- Big File
+                ( { model | dragDrop = { old_dragDrop 
+                                        | hover = False
+                                        , state = DS_Processing
+                                        , file  = Just file
+                                    }
+                  }
+                , Task.perform Msg_DrgDrp_DecodedFiles (File.toString file)
+                )
+            else
+                ( { model 
+                        | dragDrop = { old_dragDrop 
+                                        | hover = False
+                                        , state = DS_Processing
+                                        , file  = Just file
+                                    }
+                  }
+                , Task.perform Msg_DrgDrp_DecodedFiles
+                    ( Process.sleep 2000
+                      |> Task.andThen (\_ -> File.toString file)
+                    )
+                )
+
+        Msg_DrgDrp_DecodedFiles content ->
+            case doDecodeModel content of
+                Just new_model ->
+                    ( { model
+                        | exampleChooserOpen = False
+                        , dragDrop = { old_dragDrop 
+                                        | state = DS_Sucess
+                                        , hover = False
+                                        , fileContent = Just content 
+                                    }
+                        , pc_model = new_model.pc_model
+                    }
+                    , sendProcessing "Done"
+                    )
+                Nothing ->
+                    ( { model
+                        | exampleChooserOpen = False
+                        , dragDrop = { old_dragDrop 
+                                        | state = DS_Failure
+                                        , hover = False
+                                        , fileContent = Just content
+                                    }
+                    }
+                    , sendProcessing "Done"
+                    )
+
     
 
 -- ###############################################################################
@@ -210,7 +305,6 @@ doDecodeModel jText =
     |> JD.decodeString modelDecoder        
     |> error2maybe
 
-
 modelDecoder : JD.Decoder Model
 modelDecoder =  
     let
@@ -218,7 +312,7 @@ modelDecoder =
         mainDecoder version =
             if (version == pcModelVersion) then
                 JD.map2
-                    (\a b -> Model a b [] False Waiting Waiting )
+                    (\a b -> Model a b [] False Waiting Waiting initDragDrop )
                     ( JD.field "pc_model"           PC.Json.pcModelDecoder  )
                     ( JD.field "autoscroll"         JD.bool         )
             else
@@ -227,7 +321,9 @@ modelDecoder =
     JD.field "model-version" JD.string
     |> JD.andThen mainDecoder
     
-
+dropDecoder : JD.Decoder Msg
+dropDecoder =
+  JD.at ["dataTransfer","files"] (JD.oneOrMore Msg_DrgDrp_GotFiles File.decoder)
 
 
 -- #####################################################################
@@ -241,13 +337,16 @@ modelDecoder =
 
 view : Model -> Html Msg
 view model =
-    lazy viewPC model
+    div []
+        [ lazy viewPC model
+        , viewDragDrop model 
+        ]
 
 
 viewPC : Model -> Html Msg
 viewPC model =
     div
-        [ class "pc" ]
+        ([ class "pc" ] ++ dragDropAttributes)
         [ div [ class "controls", class "grid-fullwidth" ]
             [ button [ onClick <| Msg_PC PM_B_UCycleStep ] [ text "µCycle" ]
             , button [ onClick <| Msg_PC PM_B_InstructionStep ] [ text "Instruction" ]
@@ -279,17 +378,25 @@ viewPC model =
 
    
 
-
-
-
-    
-
 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 <| Msg_DEsmpl_Open False ] []
+                , div 
+                    [ class "button-group" ]
+                    [ button 
+                        [ onClick Msg_DEsmpl_Download ] 
+                        [ text "Download current config" ]
+                    , button 
+                        [ onClick Msg_DEsmpl_Upload ] 
+                        [ text "Upload" ]
+                    ]
+
+                , Html.span 
+                    [ class "example-scroller-label" ]
+                    [ text "Premade examples" ]
                 , lazy viewExamplesEntrys model
                 ]
             ]
@@ -309,7 +416,7 @@ viewExamplesEntrys model =
         Waiting ->
             div [] [ text "Loading..." ]
         Success ->
-            div [ class "scroller" ]
+            div [ class "scroller", class "examples-list" ]
                 [ Html.table [] 
                     <| List.map entry2html 
                     <| List.indexedMap Tuple.pair model.examples
@@ -330,6 +437,39 @@ viewExamplesLoaderError model =
         _ -> text ""
 
 
+
+viewDragDrop : Model -> Html Msg
+viewDragDrop model =
+    div
+        ([ classList 
+            [ ("dragDrop", True)
+            , ("hover", model.dragDrop.hover || model.dragDrop.state == DS_Failure)
+            , ("loading", model.dragDrop.state == DS_Processing)
+            ]
+        ] ++ dragDropAttributes)
+        [ div 
+            [ class "loader" ]
+            <| List.repeat 10 <| div [] []
+        , p 
+            []
+            [ case (model.dragDrop.hover, model.dragDrop.state) of
+                (_,DS_Failure)    -> text <| "Oh no, that didn't work. " ++ Debug.toString model.dragDrop
+                (_,DS_Processing) -> text "Processing. Hold on tight."
+                (True,_)          -> text "Let go to load the file."
+                (_,DS_Sucess)     -> text <| "Success" ++ Debug.toString model.dragDrop
+                (_,DS_Ready)      -> text "Let go to load the file."
+            ]
+        ]
+
+
+dragDropAttributes : List (Attribute Msg)
+dragDropAttributes =
+    [ hiJackOn "dragenter" <| JD.succeed <| Msg_DrgDrp_Hover True
+    , hiJackOn "dragover"  <| JD.succeed <| Msg_DrgDrp_Hover True
+    , hiJackOn "dragleave" <| JD.succeed <| Msg_DrgDrp_Hover False
+    , hiJackOn "drop"         dropDecoder
+    ]
+
 -- END VIEWERS
 -- #####################################################################
 -- #####################################################################
@@ -344,8 +484,16 @@ viewExamplesLoaderError model =
 --changeAtUCode pos newVal list =
 --    changeAt pos newVal ActNothing list
 
+hiJack : msg -> (msg, Bool)
+hiJack msg =
+  (msg, True)
 
 
+-- Thanks to https://elm-lang.org/examples/drag-and-drop
+hiJackOn : String -> JD.Decoder msg -> Attribute msg
+hiJackOn event decoder =
+  preventDefaultOn event (JD.map hiJack decoder)
+
 -- END HELPERS
 -- #####################################################################
 -- #####################################################################
@@ -373,10 +521,17 @@ init flags =
     ,  exampleChooserOpen   = False
     ,  examplesListStatus   = Waiting
     ,  exampleLoaderStatus  = Waiting
+    ,  dragDrop             = initDragDrop
     }
     , Cmd.none )
 
-    --( Model initialPC initialUCodes True [] False Waiting Waiting, Cmd.none )
+initDragDrop : DragDrop
+initDragDrop =
+    { hover       = False
+    , state       = DS_Ready
+    , file        = Nothing
+    , fileContent = Nothing
+    }
 
 
 

src/PC/View.elm

@@ -147,15 +147,17 @@ viewCu model =
         , p []
             [ div [class "input-row"] 
                 [ Html.label [ HAttr.for "cu-progcounter" ] [ text "Programm Counter:" ]
-                , button 
+                , div [ class "input-group" ]
-                    [ onClick <| PM_ManualStep UA_InstructionReg2ProgrammCounter ]
+                    [ button 
-                    [ text "InstRA -> " ]
+                        [ onClick <| PM_ManualStep UA_InstructionReg2ProgrammCounter ]
-                , Html.input
+                        [ text "InstRA -> " ]
-                    [ HAttr.type_ "number"
+                    , Html.input
-                    , HAttr.id "cu-progcounter"
+                        [ HAttr.type_ "number"
-                    , value (addLeadingZero model.pc.programmCounter 3)
+                        , HAttr.id "cu-progcounter"
-                    , onInput PM_F_CuProgCounterEdit
+                        , value (addLeadingZero model.pc.programmCounter 3)
-                    ] []
+                        , onInput PM_F_CuProgCounterEdit
+                        ] []
+                    ]
                 ]
 
             , div [class "input-row"] 
@@ -180,18 +182,18 @@ viewCu model =
 
             , div [class "input-row"] 
                 [ Html.label [ HAttr.for "cu-uCounter" ] [ text "µCode Counter:" ]
-                , button 
+                , div [ class "input-group" ]
-                    [ onClick <| PM_ManualStep UA_InstructionReg2UCounter
+                    [ button 
+                        [ onClick <| PM_ManualStep UA_InstructionReg2UCounter ]
+                        [ text "IntrRI ->" ]
+                    , Html.input
+                        [ HAttr.type_ "number"
+                        , HAttr.id "cu-uCounter"
+                        , value (addLeadingZero model.pc.uCounter 4)
+                        , onInput PM_F_CuUCounterEdit
+                        ] []
                     ]
-                    [ text "IntrRI ->" ]
-                , Html.input
-                    [ HAttr.type_ "number"
-                    , HAttr.id "cu-uCounter"
-                    , value (addLeadingZero model.pc.uCounter 4)
-                    , onInput PM_F_CuUCounterEdit
-                    ] []
                 ]
-
             ]
         , div [ class "scroller" ]
             [ viewCuUCode model