Implemented Im- and Export by user

This commit is contained in:
Christian 2021-05-09 17:56:40 +02:00
parent b3478d7eb3
commit 8867374f85
2 changed files with 204 additions and 47 deletions

View File

@ -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 localStorageSend : String -> Cmd msg
port sendUUpdate : String -> Cmd msg
port localStorageSend : String -> Cmd msg
port sendProcessing : String -> Cmd msg
-- #####################################################################
-- #####################################################################
type alias Model =
{ pc_model : PC_Model
, autoscroll : Bool
, examples : List Example
, exampleChooserOpen : Bool
, examplesListStatus : LoaderState
, exampleLoaderStatus : LoaderState
{ pc_model : PC_Model
, autoscroll : Bool
, examples : List Example
, exampleChooserOpen : Bool
, examplesListStatus : LoaderState
, exampleLoaderStatus : LoaderState
, dragDrop : DragDrop
}
type alias Example =
{ title : String
, version : String
, url : String
, enabled : Bool
{ title : String
, version : String
, url : String
, 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" ]
@ -277,12 +376,7 @@ viewPC model =
, lazy viewExamplesLoaderError model
]
viewExamples : Model -> Html Msg
viewExamples model =
@ -290,6 +384,19 @@ viewExamples model =
[ 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
}

View File

@ -147,15 +147,17 @@ viewCu model =
, p []
[ div [class "input-row"]
[ Html.label [ HAttr.for "cu-progcounter" ] [ text "Programm Counter:" ]
, button
[ onClick <| PM_ManualStep UA_InstructionReg2ProgrammCounter ]
[ text "InstRA -> " ]
, Html.input
[ HAttr.type_ "number"
, HAttr.id "cu-progcounter"
, value (addLeadingZero model.pc.programmCounter 3)
, onInput PM_F_CuProgCounterEdit
] []
, div [ class "input-group" ]
[ button
[ onClick <| PM_ManualStep UA_InstructionReg2ProgrammCounter ]
[ text "InstRA -> " ]
, Html.input
[ HAttr.type_ "number"
, HAttr.id "cu-progcounter"
, 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
[ onClick <| PM_ManualStep UA_InstructionReg2UCounter
, div [ class "input-group" ]
[ 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