Skip to content

Commit

Permalink
Merge pull request #90 from CSchank/machine_codec
Browse files Browse the repository at this point in the history 
Machine codec
  • Loading branch information
@CSchank
CSchank authored Mar 1, 2020
2 parents 4fdb0fa + 2ababf4 commit 5ede7d9
Show file tree
Hide file tree
Showing 16 changed files with 1,697 additions and 236 deletions.
7 changes: 6 additions & 1 deletion .travis.yml
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,9 @@
language: elm

install:
- npm install -g [email protected]
- npm install -g [email protected]
- npm install -g [email protected]
env:
global:
- secure: C9poA+wbk5f2SMct/hZe2GDGRvGofIwoGJyvWQOkSVfV016YrtDMmOrrYXjx5qBmY3mO7dejG/D7yZHUKHqQO6QmAOMyrP1Efj1xqAZwOUH8z0I82mb7xjfd0pSrT/HHxd030orVRxqfOTXawvkRHcQ9/H3oREiHgV+IccFRVpTVf8avYREV7cds7p62VNj/3uK1De/etdnDxWFWEQldkdlE1dNE/KMX6SsJGs0JMMC8ubyG5sVIaBs9XPo6DPs9jphioyCmZbVzqms8F0Wirzn4OYbLIXMkV73OywCQmRBo41i/SOHIfACfKBzTnleQ8RwuCxMr9PxGD0s8+W8r1tsWYsr5nqxj8YtW2U9BI8a2P3yYyfw95jh2xrKYiJGHvVZaE0crB8xK9V7UurvrBZs1W402mKCmw0RCqc5HGyCwT4croJb6cj6IdVLurBbomcR3iUL8JuFPPihJdCVjJddO9hEnqcwr2MzcLNXR2MXIlSGX5WPAB+D7WYsfMfJwTdO2LvvToXPUc4dujnodWKjpk/PDAiOJNSEOdyTXOP/bQn7+9B9kwngfqTXdSM/EngabpdZhjRDSLqtkxzR6/3AMWvg/X0jKPds7Z1xn8cDcshOhFuHrKD6BacbkGuN7WHtemm+JCowSn70Yl/6xIWA1bpa6suFLzbCpvKXlHgk=
Expand Down Expand Up @@ -29,4 +34,4 @@ jobs:
stages:
- test
- name: deploy
if: "(branch = master) AND (type = push)"
if: "(branch = master) AND (tag IS present)"
15 changes: 9 additions & 6 deletions elm.json
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,24 +3,27 @@
"source-directories": [
"src"
],
"elm-version": "0.19.0",
"elm-version": "0.19.1",
"dependencies": {
"direct": {
"MacCASOutreach/graphicsvg": "6.1.0",
"billstclair/elm-sha256": "1.0.8",
"MacCASOutreach/graphicsvg": "5.1.0",
"billstclair/elm-sha256": "1.0.9",
"elm/browser": "1.0.1",
"elm/core": "1.0.2",
"elm/html": "1.0.0",
"elm/http": "1.0.0",
"elm/json": "1.1.2",
"elm/random": "1.0.0",
"elm/svg": "1.0.1",
"elm/time": "1.0.0",
"elm/url": "1.0.0",
"elm-community/undo-redo": "3.0.0"
"elm-community/undo-redo": "3.0.0",
"ianmackenzie/elm-units": "2.2.0",
"rundis/elm-bootstrap": "5.2.0"
},
"indirect": {
"avh4/elm-color": "1.0.0",
"elm/regex": "1.0.0",
"elm/svg": "1.0.1",
"elm/virtual-dom": "1.0.2",
"elm-community/list-extra": "8.1.0"
}
Expand All @@ -31,4 +34,4 @@
},
"indirect": {}
}
}
}
21 changes: 21 additions & 0 deletions src/ApplicationModel.elm
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,21 @@
module ApplicationModel exposing (..)

import Building
import Exporting
import SharedModel exposing (SharedModel)
import Simulating


type ApplicationState
= Building Building.Model
| Simulating Simulating.Model
| Exporting Exporting.Model


type alias ApplicationModel =
{ appState : ApplicationState
, simulatingData : Simulating.PersistentModel
, buildingData : Building.PersistentModel
, exportingData : Exporting.PersistentModel
, sharedModel : SharedModel
}
82 changes: 11 additions & 71 deletions src/Building.elm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@ import GraphicSVG exposing (..)
import Helpers exposing (..)
import Json.Decode as D
import Machine exposing (..)
import Mistakes exposing (..)
import Set
import SharedModel exposing (SharedModel)
import Task
Expand All @@ -33,7 +34,7 @@ type Msg
| SaveStateName StateID String
| SaveTransitionName TransitionID String
| AddState ( Float, Float )
| KeyPressed Int
| KeyPressed String
| ToggleSnap
| ChangeSnap Int
| NoOp
Expand All @@ -42,7 +43,7 @@ type Msg
subscriptions : Model -> Sub Msg
subscriptions model =
Sub.batch
[ Browser.Events.onKeyDown (D.map KeyPressed (D.field "keyCode" D.int))
[ Browser.Events.onKeyDown (D.map KeyPressed (D.field "key" D.string))
]


Expand Down Expand Up @@ -147,34 +148,6 @@ update env msg ( model, pModel, sModel ) =
isValidTransition =
checkTransitionValid newTrans

oldTransitionMistakes =
oldMachine.transitionMistakes

newTransitionMistakes =
if isValidTransition then
case oldTransitionMistakes of
Just setOfMistakes ->
let
newSetOfMistakes =
Set.remove newTransID setOfMistakes
in
if Set.isEmpty newSetOfMistakes then
Nothing

else
Just newSetOfMistakes

Nothing ->
Nothing

else
case oldTransitionMistakes of
Just setOfMistakes ->
Just <| Set.insert newTransID setOfMistakes

Nothing ->
Just <| Set.singleton newTransID

newDelta : Delta
newDelta =
Dict.update st
Expand Down Expand Up @@ -208,7 +181,6 @@ update env msg ( model, pModel, sModel ) =
| delta = newDelta
, transitionNames = Dict.insert newTransID newTrans oldMachine.transitionNames
, stateTransitions = Dict.insert ( st, newTransID, s1 ) newTransPos oldMachine.stateTransitions
, transitionMistakes = newTransitionMistakes
}
}
)
Expand Down Expand Up @@ -425,7 +397,7 @@ update env msg ( model, pModel, sModel ) =
( ( { model | machineState = Regular }, pModel, sModel ), False, Cmd.none )

KeyPressed k ->
if k == 13 then
if k == "Enter" then
--pressed enter
case model.machineState of
EditingStateLabel sId newLbl ->
Expand Down Expand Up @@ -463,8 +435,7 @@ update env msg ( model, pModel, sModel ) =
_ ->
( ( model, pModel, sModel ), False, Cmd.none )

else if k == 68 then
--pressed delete
else if k == "d" then
case model.machineState of
SelectedState stId ->
let
Expand All @@ -485,15 +456,11 @@ update env msg ( model, pModel, sModel ) =
, stateTransitions = newStateTransitions
, stateNames = Dict.remove stId oldMachine.stateNames
, transitionNames = Dict.diff oldMachine.transitionNames removedTransitions
, transitionMistakes = newTMistakes
}

newStateTransitions =
Dict.filter (\( _, t, _ ) _ -> not <| Dict.member t removedTransitions) oldMachine.stateTransitions

newTMistakes =
List.foldr (\tId mistakes -> tMistakeRemove (first tId) mistakes) oldMachine.transitionMistakes removedTransitionsLst

removedTransitionsLst =
List.map (\( _, t, _ ) -> ( t, () )) <| Dict.keys <| Dict.filter (\( s0, _, s1 ) _ -> s0 == stId || s1 == stId) oldMachine.stateTransitions

Expand All @@ -512,28 +479,23 @@ update env msg ( model, pModel, sModel ) =
| delta = newDelta
, stateTransitions = newStateTransitions
, transitionNames = Dict.remove tId oldMachine.transitionNames
, transitionMistakes = newTMistakes
}

newStateTransitions =
Dict.filter (\( _, tId0, _ ) _ -> tId /= tId0) oldMachine.stateTransitions

newTMistakes =
tMistakeRemove tId oldMachine.transitionMistakes
in
( ( { model | machineState = Regular }, pModel, { sModel | machine = newMachine } ), True, Cmd.none )

_ ->
( ( model, pModel, sModel ), False, Cmd.none )

else if k == 71 then
--pressed G
else if k == "g" then
( ( model, pModel, sModel ), False, sendMsg ToggleSnap )

else
case model.machineState of
SelectedState sId ->
if k == 70 then
if k == "f" then
let
newMachine =
{ oldMachine
Expand Down Expand Up @@ -569,20 +531,9 @@ update env msg ( model, pModel, sModel ) =
isValidTransition =
checkTransitionValid newTransitions

oldTransitionMistakes =
oldMachine.transitionMistakes

newTransitionMistakes =
if isValidTransition then
tMistakeRemove tId oldTransitionMistakes

else
tMistakeAdd tId oldTransitionMistakes

newMachine =
{ oldMachine
| transitionNames = Dict.insert tId newTransitions oldMachine.transitionNames
, transitionMistakes = newTransitionMistakes
}
in
( ( { model | machineState = Regular }, pModel, { sModel | machine = newMachine } ), True, Cmd.none )
Expand Down Expand Up @@ -632,6 +583,9 @@ view env ( model, pModel, sModel ) =

winY =
toFloat <| second env.windowSize

transMistakes =
getTransitionMistakes sModel.machine
in
group
[ rect winX winY
Expand Down Expand Up @@ -666,7 +620,7 @@ view env ( model, pModel, sModel ) =

_ ->
group []
, GraphicSVG.map MachineMsg <| Machine.view env model.machineState sModel.machine Set.empty
, GraphicSVG.map MachineMsg <| Machine.view env model.machineState sModel.machine Set.empty transMistakes
, editingButtons model |> move ( winX / 2 - 30, -winY / 2 + 25 )
]

Expand Down Expand Up @@ -763,17 +717,3 @@ snapIcon =
]
|> move ( 5, -10 )
]


checkTransitionValid : Set.Set String -> Bool
checkTransitionValid set =
case Set.member "\\epsilon" set of
False ->
True

True ->
if Set.size set == 1 then
True

else
False
6 changes: 6 additions & 0 deletions src/Environment.elm
View file
Original file line number Diff line number Diff line change
@@ -1,12 +1,16 @@
module Environment exposing (Environment, init)

import Time


init : Environment
init =
{ windowSize = ( 0, 0 )
, holdingShift = False
, holdingControl = False
, holdingMeta = False
, currentTime = Time.millisToPosix 1576798602274
, timeZone = Time.utc
}


Expand All @@ -15,4 +19,6 @@ type alias Environment =
, holdingShift : Bool
, holdingControl : Bool
, holdingMeta : Bool
, currentTime : Time.Posix
, timeZone : Time.Zone
}
3 changes: 2 additions & 1 deletion src/Error.elm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@ import Environment exposing (Environment)
import GraphicSVG exposing (..)
import Helpers exposing (..)
import Machine exposing (Machine, StateID, TransitionID)
import Mistakes exposing (..)
import Set exposing (Set)
import SharedModel exposing (..)
import Tuple exposing (first, second)
Expand Down Expand Up @@ -57,7 +58,7 @@ machineCheck sModel =
sModel.machine

tMistakes =
sModel.machine.transitionMistakes
getTransitionMistakes mac

allTransitionLabels =
List.sort <| Set.toList <| Set.remove "\\epsilon" <| List.foldr Set.union Set.empty <| Dict.values mac.transitionNames
Expand Down
6 changes: 5 additions & 1 deletion src/Exporting.elm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@ import Html as H
import Html.Attributes as A
import Json.Decode as D
import Machine exposing (..)
import Mistakes exposing (..)
import Set exposing (Set)
import Sha256 exposing (sha256)
import SharedModel exposing (..)
Expand Down Expand Up @@ -122,6 +123,9 @@ view env ( model, pModel, sModel ) =
hasErr =
contextHasError errCheck sModel.machineType

transMistakes =
getTransitionMistakes oldMachine

-- TODO: Adjust popup box size to fix custom error messages
errHover =
group
Expand All @@ -137,7 +141,7 @@ view env ( model, pModel, sModel ) =
|> move ( winX / 6 - 100, -105 )
in
group
[ (GraphicSVG.map MachineMsg <| Machine.view env Regular sModel.machine sModel.machine.start) |> move ( -winX / 6, 0 )
[ (GraphicSVG.map MachineMsg <| Machine.view env Regular sModel.machine sModel.machine.start transMistakes) |> move ( -winX / 6, 0 )
, machineSelected sModel.machineType winX winY
, text "Choose format:"
|> size 20
Expand Down
13 changes: 13 additions & 0 deletions src/Helpers.elm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -96,6 +96,19 @@ type LatexAlign


latex w h backclr txt align =
--image (latexurl txt)
-- |> move
-- ( case align of
-- AlignLeft ->
-- 0
--
-- AlignRight ->
-- -w
--
-- AlignCentre ->
-- -w / 2
-- , 0
-- )
(html w h <|
H.div
[ style "width" "100%"
Expand Down
Loading

0 comments on commit 5ede7d9

Please sign in to comment.