610 lines
20 KiB
Elm
610 lines
20 KiB
Elm
--module Main exposing (Model, Msg, update, view, init)
|
|
|
|
|
|
port module Main exposing (..)
|
|
|
|
import Browser
|
|
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, preventDefaultOn)
|
|
import Html.Lazy exposing (lazy)
|
|
import Tuple
|
|
import Array exposing (get)
|
|
--import Html exposing (address)
|
|
import Json.Encode as JE
|
|
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
|
|
import PC.Helpers exposing (..)
|
|
|
|
-- Note that general Stuff is at the end of the document
|
|
|
|
examplesListUrl = "examples-list.json"
|
|
|
|
-- ####################################################
|
|
-- PORTS
|
|
-- ####################################################
|
|
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
|
|
, dragDrop : DragDrop
|
|
, showAlert : Bool
|
|
}
|
|
|
|
type alias Example =
|
|
{ title : String
|
|
, version : String
|
|
, url : String
|
|
, enabled : Bool
|
|
}
|
|
|
|
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
|
|
| Msg_DEsmpl_Open Bool
|
|
| Msg_DEsmpl_EClick Int
|
|
| Msg_DEsmpl_LoadWithDelay Example
|
|
| 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
|
|
| Msg_Alert_Hide
|
|
| Msg_Nothing
|
|
|
|
|
|
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
|
|
(new_pc, pua) = PC.update pc_msg model.pc_model
|
|
new_model = {model | pc_model = new_pc}
|
|
in
|
|
case pua of
|
|
PUA_Nothing ->
|
|
( new_model
|
|
, Cmd.none)
|
|
PUA_Storage ->
|
|
( new_model
|
|
, cmd_up_lStorage new_model)
|
|
PUA_Scroller ->
|
|
( new_model
|
|
, cmd_scoller new_model )
|
|
PUA_Storage_And_Scroller ->
|
|
( new_model
|
|
, cmd_up_lStorage_n_Scroller new_model
|
|
)
|
|
PUA_Alert ->
|
|
( { new_model | showAlert = True }
|
|
, cmd_up_lStorage new_model
|
|
)
|
|
|
|
|
|
Msg_Autoscroll_Toggle -> -- User toggled automatic scrolling checkbox
|
|
let
|
|
new_model = { model | autoscroll = not model.autoscroll }
|
|
in
|
|
( new_model, cmd_up_lStorage_n_Scroller new_model )
|
|
|
|
|
|
Msg_DEsmpl_Open True -> -- When the user clicks on "open examples"
|
|
( { model | exampleChooserOpen = True }
|
|
, Http.get
|
|
{ url = examplesListUrl
|
|
, expect = Http.expectJson Msg_DEsmpl_ListLoaded exampleListDecoder
|
|
}
|
|
)
|
|
|
|
Msg_DEsmpl_Open False -> -- User closes Dialog
|
|
( { model | exampleChooserOpen = False }, Cmd.none )
|
|
|
|
Msg_DEsmpl_EClick i -> -- User chose example. Load it.
|
|
case valueAt i model.examples of
|
|
Just example ->
|
|
( { model | dragDrop = { old_dragDrop | state = DS_Processing } }
|
|
, Task.perform
|
|
(\_ -> Msg_DEsmpl_LoadWithDelay example)
|
|
<| Process.sleep 500
|
|
)
|
|
|
|
Nothing ->
|
|
( model, Cmd.none )
|
|
|
|
Msg_DEsmpl_LoadWithDelay example ->
|
|
( model
|
|
, Http.get
|
|
{ url = example.url
|
|
, expect = Http.expectJson Msg_DEsmpl_ExampleLoaded modelDecoder
|
|
}
|
|
)
|
|
|
|
Msg_DEsmpl_ExampleLoaded result -> -- When a single example is loaded
|
|
case result of
|
|
Ok example_model ->
|
|
let
|
|
new_model =
|
|
{ model
|
|
| pc_model = example_model.pc_model
|
|
, exampleLoaderStatus = Success
|
|
, exampleChooserOpen = False
|
|
, dragDrop = { old_dragDrop | state = DS_Sucess }
|
|
}
|
|
in
|
|
( new_model
|
|
, cmd_up_lStorage_n_Scroller new_model
|
|
)
|
|
Err err ->
|
|
( { model | exampleLoaderStatus = Failure <| printHttpError err
|
|
, dragDrop = { old_dragDrop | state = DS_Sucess }
|
|
}
|
|
, Cmd.none )
|
|
|
|
|
|
Msg_DEsmpl_ListLoaded result ->
|
|
case result of
|
|
Ok exampleList ->
|
|
( { model | examples = exampleList, examplesListStatus = Success }
|
|
, Cmd.none )
|
|
Err err ->
|
|
( { 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"
|
|
)
|
|
|
|
Msg_Alert_Hide ->
|
|
( {model | showAlert = False}
|
|
, Cmd.none)
|
|
|
|
Msg_Nothing -> (model, Cmd.none)
|
|
|
|
|
|
|
|
-- ###############################################################################
|
|
|
|
cmd_up_lStorage : Model -> Cmd Msg
|
|
cmd_up_lStorage model =
|
|
localStorageSend (doEncodeModel model)
|
|
|
|
cmd_scoller : Model -> Cmd Msg
|
|
cmd_scoller model =
|
|
sendUUpdate "update"
|
|
|
|
cmd_up_lStorage_n_Scroller : Model -> Cmd Msg
|
|
cmd_up_lStorage_n_Scroller model =
|
|
Cmd.batch
|
|
[ cmd_up_lStorage model
|
|
, cmd_scoller model
|
|
]
|
|
|
|
-- ###############################################################################
|
|
-- ###############################################################################
|
|
|
|
|
|
|
|
-- ###############################################################################
|
|
-- Encoders and Decoders
|
|
-- ###############################################################################
|
|
|
|
|
|
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) )
|
|
|
|
|
|
doEncodeModel : Model -> String
|
|
doEncodeModel model =
|
|
JE.object
|
|
[ ( "model-version" , JE.string pcModelVersion )
|
|
, ( "pc_model" , PC.Json.pcModelEncoder model.pc_model )
|
|
, ( "autoscroll" , JE.bool model.autoscroll )
|
|
]
|
|
|> JE.encode 0
|
|
|
|
doDecodeModel : String -> Maybe Model
|
|
doDecodeModel jText =
|
|
let
|
|
error2maybe err =
|
|
case err of
|
|
Ok val -> Just val
|
|
_ -> Nothing
|
|
in
|
|
jText
|
|
|> JD.decodeString modelDecoder
|
|
|> error2maybe
|
|
|
|
modelDecoder : JD.Decoder Model
|
|
modelDecoder =
|
|
let
|
|
mainDecoder : String -> JD.Decoder Model
|
|
mainDecoder version =
|
|
if (version == pcModelVersion) then
|
|
JD.map2
|
|
(\a b -> Model a b [] False Waiting Waiting initDragDrop False )
|
|
( JD.field "pc_model" PC.Json.pcModelDecoder )
|
|
( JD.field "autoscroll" JD.bool )
|
|
else
|
|
JD.fail <| "Outdated version: '" ++ version ++ "'"
|
|
in
|
|
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)
|
|
|
|
|
|
-- #####################################################################
|
|
-- #####################################################################
|
|
|
|
|
|
|
|
-- #####################################################################
|
|
-- VIEWERS
|
|
-- #####################################################################
|
|
|
|
view : Model -> Html Msg
|
|
view model =
|
|
div []
|
|
[ lazy viewPC model
|
|
, viewDragDrop model
|
|
, viewAlert model
|
|
]
|
|
|
|
|
|
viewPC : Model -> Html Msg
|
|
viewPC model =
|
|
div
|
|
([ 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" ]
|
|
, button [ onClick <| Msg_PC PM_B_Reset ] [ text "Reset PC" ]
|
|
, div
|
|
[ classList
|
|
[ ("checker", True)
|
|
, ("button", True)
|
|
, ("checked", model.autoscroll) ]
|
|
, onClick Msg_Autoscroll_Toggle
|
|
]
|
|
[ Html.input
|
|
[ HAttr.type_ "checkbox"
|
|
, HAttr.id "enableScrolling"
|
|
, HAttr.checked model.autoscroll
|
|
, onClick Msg_Autoscroll_Toggle
|
|
]
|
|
[]
|
|
, Html.label
|
|
[ HAttr.for "enableScrolling" ]
|
|
[ text "Autoscroll" ]
|
|
]
|
|
, button [ onClick <| Msg_DEsmpl_Open True ] [ text "Configs" ]
|
|
]
|
|
, div [class "pc-main"] [ Html.map Msg_PC <| PC.view model.pc_model ]
|
|
, lazy viewExamples model
|
|
, lazy viewExamplesLoaderError 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
|
|
]
|
|
]
|
|
|
|
viewExamplesEntrys : Model -> Html Msg
|
|
viewExamplesEntrys model =
|
|
let
|
|
entry2html (id, example) =
|
|
Html.tr []
|
|
[ Html.td [] [ text <| "Example: " ++ example.title ]
|
|
, Html.td [] [ button [ onClick <| Msg_DEsmpl_EClick 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", class "examples-list" ]
|
|
[ 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 ""
|
|
|
|
|
|
|
|
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. "
|
|
(_,DS_Processing) -> text "Loading. Hold on tight."
|
|
(True,_) -> text "Let go to load the file."
|
|
(_,DS_Sucess) -> text <| "Success"
|
|
(_,DS_Ready) -> text "Let go to load the file."
|
|
]
|
|
]
|
|
|
|
|
|
viewAlert : Model -> Html Msg
|
|
viewAlert model =
|
|
div
|
|
[ classList
|
|
[("modal", True)
|
|
, ("hidden", not model.showAlert)]
|
|
]
|
|
[ div [] []
|
|
, div [ class "modal-card" ]
|
|
[ p []
|
|
[ text "End of Program reached" ]
|
|
, button
|
|
[ onClick Msg_Alert_Hide ]
|
|
[ text "Ok" ]
|
|
]
|
|
]
|
|
|
|
|
|
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
|
|
-- #####################################################################
|
|
-- #####################################################################
|
|
|
|
|
|
-- #####################################################################
|
|
-- HELPERS
|
|
-- #####################################################################
|
|
|
|
|
|
--changeAtUCode : Int -> UAction -> List UAction -> List UAction
|
|
--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
|
|
-- #####################################################################
|
|
-- #####################################################################
|
|
|
|
|
|
|
|
-- #####################################################################
|
|
-- GENERAL
|
|
-- #####################################################################
|
|
|
|
|
|
subscriptions : Model -> Sub Msg
|
|
subscriptions model =
|
|
Sub.none
|
|
--localStorageRecieve Msg_LocalStorageLoaded
|
|
|
|
|
|
|
|
-- TODO: Make it load localStorage when starting
|
|
init : String -> ( Model, Cmd Msg )
|
|
init mayLocalStorage =
|
|
case doDecodeModel mayLocalStorage of
|
|
Just init_model ->
|
|
({ pc_model = init_model.pc_model
|
|
, autoscroll = init_model.autoscroll
|
|
, examples = []
|
|
, exampleChooserOpen = False
|
|
, examplesListStatus = Waiting
|
|
, exampleLoaderStatus = Waiting
|
|
, dragDrop = initDragDrop
|
|
, showAlert = False
|
|
}
|
|
, Cmd.none )
|
|
Nothing ->
|
|
({ pc_model = PC.init
|
|
, autoscroll = True
|
|
, examples = []
|
|
, exampleChooserOpen = False
|
|
, examplesListStatus = Waiting
|
|
, exampleLoaderStatus = Waiting
|
|
, dragDrop = initDragDrop
|
|
, showAlert = False
|
|
}
|
|
, Cmd.none )
|
|
|
|
initDragDrop : DragDrop
|
|
initDragDrop =
|
|
{ hover = False
|
|
, state = DS_Ready
|
|
, file = Nothing
|
|
, fileContent = Nothing
|
|
}
|
|
|
|
|
|
|
|
main : Program String Model Msg
|
|
main =
|
|
Browser.element
|
|
{ init = init
|
|
, view = view
|
|
, update = update
|
|
, subscriptions = subscriptions
|
|
}
|
|
|
|
|
|
-- #####################################################################
|
|
-- #####################################################################
|
|
|
|
-- Done. |