Make Edits persist after reload
This commit is contained in:
165
src/Main.elm
165
src/Main.elm
@ -11,10 +11,11 @@ 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)
|
||||
|
||||
|
||||
modelVersion = 1
|
||||
|
||||
-- Note that general Stuff is at the end of the document
|
||||
-- PORTS
|
||||
@ -23,10 +24,10 @@ import Html.Events exposing (targetValue)
|
||||
port sendUUpdate : String -> Cmd msg
|
||||
|
||||
|
||||
port sendRamUpdate : String -> Cmd msg
|
||||
port localStorageSend : String -> Cmd msg
|
||||
|
||||
|
||||
port recieveLocalSession : (String -> msg) -> Sub msg
|
||||
port localStorageRecieve : (String -> msg) -> Sub msg
|
||||
|
||||
|
||||
type alias PC =
|
||||
@ -82,6 +83,23 @@ uCodeDescriptions =
|
||||
, ( ActNothing, "Empty" )
|
||||
]
|
||||
|
||||
uCodeIds : List ( UAction, String )
|
||||
uCodeIds =
|
||||
[ ( ActAccumulator2DataBus, "acc2db" )
|
||||
, ( ActAccumulatorDecrement, "accDec" )
|
||||
, ( ActAccumulatorIncrement, "accInc" )
|
||||
, ( ActDataBus2Accumulator, "db2acc" )
|
||||
, ( ActDataBus2InstructionReg, "db2ir" )
|
||||
, ( ActDataBus2Ram, "db2ram" )
|
||||
, ( ActInstructionReg2AddressBus, "ir2ab" )
|
||||
, ( ActInstructionReg2ProgrammCounter, "ir2pc" )
|
||||
, ( ActInstructionReg2UCounter, "ir2uc" )
|
||||
, ( ActProgrammCounterIncrement, "pcInc" )
|
||||
, ( ActRam2DataBus, "ram2db" )
|
||||
, ( ActResetUCounter, "ucReset" )
|
||||
, ( ActProgrammCounter2AddressBus, "pc2ab" )
|
||||
, ( ActNothing, "n" )
|
||||
]
|
||||
|
||||
uCodeMaps : List ( UAction, PC -> PC )
|
||||
uCodeMaps =
|
||||
@ -210,34 +228,34 @@ type Msg
|
||||
| MsgEditAddressBus String
|
||||
| MsgEditDataBus String
|
||||
| MsgAluEdit String
|
||||
| MsgLocalSessionExport
|
||||
| MsgLocalSessionRecieve String
|
||||
|
||||
|
||||
update : Msg -> Model -> ( Model, Cmd Msg )
|
||||
update msg model =
|
||||
let
|
||||
updateModel new_model =
|
||||
( new_model, cmdUpdateLocalStorage new_model)
|
||||
in
|
||||
|
||||
case msg of
|
||||
MsgUCycleStep ->
|
||||
( uStepPC model
|
||||
, sendUUpdate "uCycle updated"
|
||||
, cmdSenduUpdate model
|
||||
)
|
||||
|
||||
MsgInstructionStep ->
|
||||
( model, Cmd.none )
|
||||
|
||||
MsgReset ->
|
||||
( { model | pc = { initialPC | ram = model.pc.ram } }
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
MsgLocalSessionRecieve message_in ->
|
||||
( model, Cmd.none )
|
||||
updateModel { model | pc = { initialPC | ram = model.pc.ram } }
|
||||
|
||||
MsgManualStep action ->
|
||||
let
|
||||
instruction = getAction action
|
||||
in
|
||||
( { model | pc = instruction model.pc}
|
||||
, Cmd.none )
|
||||
updateModel { model | pc = instruction model.pc}
|
||||
|
||||
MsgRamEditAddress addr may_int ->
|
||||
case String.toInt may_int of
|
||||
@ -248,8 +266,7 @@ update msg model =
|
||||
old_pc = model.pc
|
||||
new_pc = { old_pc | ram = (changeAtInt addr new_val old_pc.ram) }
|
||||
in
|
||||
({ model | pc = new_pc }
|
||||
, Cmd.none )
|
||||
updateModel { model | pc = new_pc }
|
||||
_ -> (model, Cmd.none)
|
||||
|
||||
MsgRamEditInstr addr may_int ->
|
||||
@ -261,8 +278,7 @@ update msg model =
|
||||
old_pc = model.pc
|
||||
new_pc = { old_pc | ram = (changeAtInt addr new_val old_pc.ram) }
|
||||
in
|
||||
({ model | pc = new_pc }
|
||||
, Cmd.none )
|
||||
updateModel { model | pc = new_pc }
|
||||
_ -> ( model, Cmd.none )
|
||||
|
||||
MsgRamAddBelow ->
|
||||
@ -270,8 +286,7 @@ update msg model =
|
||||
old_pc = model.pc
|
||||
new_pc = {old_pc | ram = old_pc.ram ++ [0]}
|
||||
in
|
||||
|
||||
({model | pc = new_pc}, Cmd.none)
|
||||
updateModel {model | pc = new_pc}
|
||||
|
||||
MsgCuEditAction addr may_action ->
|
||||
case string2uAction may_action of
|
||||
@ -279,13 +294,11 @@ update msg model =
|
||||
let
|
||||
newCode = changeAtUCode addr action model.uCode
|
||||
in
|
||||
({ model | uCode = newCode }, Cmd.none)
|
||||
updateModel { model | uCode = newCode }
|
||||
_ -> ( model, Cmd.none )
|
||||
|
||||
MsgCuAddBelow ->
|
||||
( {model | uCode = model.uCode ++ [ ActNothing ]}
|
||||
, Cmd.none
|
||||
)
|
||||
updateModel {model | uCode = model.uCode ++ [ ActNothing ]}
|
||||
|
||||
MsgCuInstrRegEdit text ->
|
||||
case String.toInt text of
|
||||
@ -293,7 +306,7 @@ update msg model =
|
||||
let old_pc = model.pc
|
||||
new_pc = { old_pc | instructionReg = int }
|
||||
in
|
||||
( { model | pc = new_pc }, Cmd.none )
|
||||
updateModel { model | pc = new_pc }
|
||||
_ -> ( model, Cmd.none )
|
||||
|
||||
MsgCuProgCounterEdit text ->
|
||||
@ -302,7 +315,7 @@ update msg model =
|
||||
let old_pc = model.pc
|
||||
new_pc = { old_pc | programmCounter = int }
|
||||
in
|
||||
( { model | pc = new_pc }, Cmd.none )
|
||||
updateModel { model | pc = new_pc }
|
||||
_ -> ( model, Cmd.none )
|
||||
|
||||
MsgCuUCounterEdit text ->
|
||||
@ -311,7 +324,7 @@ update msg model =
|
||||
let old_pc = model.pc
|
||||
new_pc = { old_pc | uCounter = int }
|
||||
in
|
||||
( { model | pc = new_pc }, sendUUpdate "uCycle updated" )
|
||||
( { model | pc = new_pc }, cmdSenduUpdate model )
|
||||
_ -> ( model, Cmd.none )
|
||||
|
||||
MsgEditAddressBus text ->
|
||||
@ -320,7 +333,7 @@ update msg model =
|
||||
let old_pc = model.pc
|
||||
new_pc = { old_pc | addressBus = int }
|
||||
in
|
||||
( { model | pc = new_pc }, sendUUpdate "uCycle updated" )
|
||||
( { model | pc = new_pc }, cmdSenduUpdate model )
|
||||
_ -> ( model, Cmd.none )
|
||||
|
||||
MsgEditDataBus text ->
|
||||
@ -329,7 +342,7 @@ update msg model =
|
||||
let old_pc = model.pc
|
||||
new_pc = { old_pc | dataBus = int }
|
||||
in
|
||||
( { model | pc = new_pc }, Cmd.none )
|
||||
updateModel { model | pc = new_pc }
|
||||
_ -> ( model, Cmd.none )
|
||||
|
||||
MsgAluEdit text ->
|
||||
@ -338,13 +351,20 @@ update msg model =
|
||||
let old_pc = model.pc
|
||||
new_pc = { old_pc | accumulator = int }
|
||||
in
|
||||
( { model | pc = new_pc }, Cmd.none )
|
||||
updateModel { model | pc = new_pc }
|
||||
_ -> ( model, Cmd.none )
|
||||
|
||||
MsgAutoscrollUpdate ->
|
||||
( { model | autoscroll = not model.autoscroll }
|
||||
, Cmd.none
|
||||
)
|
||||
updateModel { model | autoscroll = not model.autoscroll }
|
||||
|
||||
MsgLocalSessionExport ->
|
||||
( model, cmdUpdateLocalStorage model )
|
||||
|
||||
MsgLocalSessionRecieve message_in ->
|
||||
case decodeModel message_in of
|
||||
Just new_model ->
|
||||
( new_model , Cmd.none )
|
||||
_ -> ( model, Cmd.none )
|
||||
|
||||
|
||||
|
||||
@ -402,7 +422,74 @@ uStepPC model =
|
||||
_ ->
|
||||
model
|
||||
|
||||
|
||||
|
||||
encodeModel : Model -> String
|
||||
encodeModel model =
|
||||
JE.object
|
||||
[ ( "model-version", JE.int modelVersion )
|
||||
, ( "pc"
|
||||
, JE.object
|
||||
[ ("addressBus", JE.int model.pc.addressBus )
|
||||
, ("dataBus", JE.int model.pc.dataBus )
|
||||
, ("instructionReg", JE.int model.pc.instructionReg )
|
||||
, ("programmCounter", JE.int model.pc.programmCounter )
|
||||
, ("uCounter", JE.int model.pc.uCounter )
|
||||
, ("accumulator", JE.int model.pc.accumulator )
|
||||
, ("ram", JE.list JE.int model.pc.ram)
|
||||
]
|
||||
)
|
||||
, ( "uCode", JE.list JE.string (List.map uAction2String model.uCode) )
|
||||
, ( "autoscroll", JE.bool model.autoscroll )
|
||||
]
|
||||
|> JE.encode 0
|
||||
|
||||
|
||||
decodeModel : String -> Maybe Model
|
||||
decodeModel 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 )
|
||||
)
|
||||
|> error2maybe
|
||||
|
||||
cmdUpdateLocalStorage : Model -> Cmd Msg
|
||||
cmdUpdateLocalStorage model =
|
||||
localStorageSend (encodeModel model)
|
||||
|
||||
cmdSenduUpdate : Model -> Cmd Msg
|
||||
cmdSenduUpdate model =
|
||||
Cmd.batch
|
||||
[ cmdUpdateLocalStorage model
|
||||
, sendUUpdate "update"
|
||||
]
|
||||
|
||||
-- VIEWERS
|
||||
|
||||
view : Model -> Html Msg
|
||||
view model =
|
||||
@ -433,8 +520,9 @@ viewPC model =
|
||||
[]
|
||||
, Html.label
|
||||
[ HAttr.for "enableScrolling" ]
|
||||
[ text "Automatisch zum Eintrag Scrollen" ]
|
||||
[ text "Autoscroll" ]
|
||||
]
|
||||
, button [ onClick MsgLocalSessionExport ] [ text "Export" ]
|
||||
]
|
||||
, div [ class "grid-fullwidth" ] [ lazy viewAddressBus model ]
|
||||
, lazy viewRam model
|
||||
@ -638,7 +726,10 @@ viewCuInstrSelect : Int -> UAction -> Html Msg
|
||||
viewCuInstrSelect id current =
|
||||
let
|
||||
info2option (action, info) =
|
||||
Html.option [ HAttr.selected (action == current) ] [ text info ]
|
||||
Html.option
|
||||
[ HAttr.selected (action == current)
|
||||
, HAttr.value (uAction2String action) ]
|
||||
[ text info ]
|
||||
listOptions = List.map info2option uCodeDescriptions
|
||||
in
|
||||
Html.select
|
||||
@ -891,7 +982,7 @@ seperateInstructionsEntry i =
|
||||
uAction2String : UAction -> String
|
||||
uAction2String action =
|
||||
let
|
||||
filtered_list = List.filter (\s -> Tuple.first s == action) uCodeDescriptions
|
||||
filtered_list = List.filter (\s -> Tuple.first s == action) uCodeIds
|
||||
in
|
||||
case List.head filtered_list of
|
||||
Just (_,info) -> info
|
||||
@ -900,7 +991,7 @@ uAction2String action =
|
||||
string2uAction : String -> Maybe UAction
|
||||
string2uAction msg =
|
||||
let
|
||||
filtered_list = List.filter (\s -> Tuple.second s == msg) uCodeDescriptions
|
||||
filtered_list = List.filter (\s -> Tuple.second s == msg) uCodeIds
|
||||
in
|
||||
case List.head filtered_list of
|
||||
Just (action,_) -> Just action
|
||||
@ -917,7 +1008,7 @@ selectCuValueDecoder =
|
||||
|
||||
subscriptions : Model -> Sub Msg
|
||||
subscriptions model =
|
||||
recieveLocalSession MsgLocalSessionRecieve
|
||||
localStorageRecieve MsgLocalSessionRecieve
|
||||
|
||||
|
||||
init : () -> ( Model, Cmd Msg )
|
||||
|
||||
Reference in New Issue
Block a user