From 7b8ae0f7228d9be0d779d84bfddb7d4d859b9fc7 Mon Sep 17 00:00:00 2001 From: CSchank Date: Thu, 7 Mar 2019 18:11:23 -0500 Subject: [PATCH 01/11] add left arrow for resetting tape position (related to #72) For now, we will not go backwards as I believe this would imply that machines can go backwards and forwards. However, having the left arrow reset the tape to the beginning is helpful. --- src/Simulating.elm | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/Simulating.elm b/src/Simulating.elm index 887afb1..d398112 100644 --- a/src/Simulating.elm +++ b/src/Simulating.elm @@ -375,6 +375,14 @@ update env msg ( model, pModel, sModel ) = _ -> ( ( model, pModel, sModel ), False, Cmd.none ) + else if k == 37 then + --left arrow key + case model of + Default tId _ hErr -> + ( (Default tId -1 hErr, { pModel | currentStates = sModel.machine.start }, sModel), False, Cmd.none) + _ -> + ( ( model, pModel, sModel ), False, Cmd.none ) + else case model of Editing tapeId -> From 4ac14048621ca041d5cbe27f92ba6e7587b05c21 Mon Sep 17 00:00:00 2001 From: CSchank Date: Thu, 7 Mar 2019 18:11:43 -0500 Subject: [PATCH 02/11] run elm-format --- src/Simulating.elm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Simulating.elm b/src/Simulating.elm index d398112..2d152ef 100644 --- a/src/Simulating.elm +++ b/src/Simulating.elm @@ -379,8 +379,9 @@ update env msg ( model, pModel, sModel ) = --left arrow key case model of Default tId _ hErr -> - ( (Default tId -1 hErr, { pModel | currentStates = sModel.machine.start }, sModel), False, Cmd.none) - _ -> + ( ( Default tId -1 hErr, { pModel | currentStates = sModel.machine.start }, sModel ), False, Cmd.none ) + + _ -> ( ( model, pModel, sModel ), False, Cmd.none ) else From fa642137ecdaa12ddcf65ee06647183636f6458c Mon Sep 17 00:00:00 2001 From: CSchank Date: Thu, 7 Mar 2019 18:25:11 -0500 Subject: [PATCH 03/11] downgrade to GraphicSVG 5.1.0 (addresses Firefox issue #70) We'll wait for a fix in GraphicSVG. For now, we don't really need anything in 6.1.0 as far as I know. --- elm.json | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/elm.json b/elm.json index cd051e8..da56120 100644 --- a/elm.json +++ b/elm.json @@ -6,7 +6,7 @@ "elm-version": "0.19.0", "dependencies": { "direct": { - "MacCASOutreach/graphicsvg": "6.1.0", + "MacCASOutreach/graphicsvg": "5.1.0", "billstclair/elm-sha256": "1.0.8", "elm/browser": "1.0.1", "elm/core": "1.0.2", From 6083d51296eb09e0e75afb5ca143bd2f97da62ce Mon Sep 17 00:00:00 2001 From: CSchank Date: Thu, 7 Mar 2019 18:26:07 -0500 Subject: [PATCH 04/11] fix #71 - text box clickability Users can now click into the text box to change cursor position or highlight part of the text. --- src/Building.elm | 3 ++- src/Machine.elm | 15 +++++++++------ 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/src/Building.elm b/src/Building.elm index 2a80d0d..99f4cd4 100644 --- a/src/Building.elm +++ b/src/Building.elm @@ -1,6 +1,7 @@ module Building exposing (Model, Msg(..), PersistentModel(..), editingButtons, init, initPModel, onEnter, onExit, subscriptions, update, updateArrowPos, updateStatePos, view) import Browser.Events +import Debug import Dict exposing (Dict) import Environment exposing (Environment) import GraphicSVG exposing (..) @@ -76,7 +77,7 @@ update env msg ( model, pModel, sModel ) = in case msg of MachineMsg mmsg -> - case mmsg of + case Debug.log "mmsg" mmsg of StartDragging st ( x, y ) -> let ( sx, sy ) = diff --git a/src/Machine.elm b/src/Machine.elm index dcbd69f..b02901f 100644 --- a/src/Machine.elm +++ b/src/Machine.elm @@ -752,15 +752,18 @@ renderStates currentStates machine model env = _ -> group [] - , rect 25 18 - |> filled blank ] |> move (getPos sId) - |> (if not env.holdingShift then - notifyMouseDownAt (StartDragging sId) + |> (case model of + EditingStateLabel _ _ -> + identity - else - notifyTap (TapState sId) + _ -> + if not env.holdingShift then + notifyMouseDownAt (StartDragging sId) + + else + notifyTap (TapState sId) ) ) stateList From 6992781abb91deb629b8c737835fadad598a6953 Mon Sep 17 00:00:00 2001 From: CSchank Date: Thu, 7 Mar 2019 18:28:23 -0500 Subject: [PATCH 05/11] remove debug logging --- src/Building.elm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Building.elm b/src/Building.elm index 99f4cd4..423eb83 100644 --- a/src/Building.elm +++ b/src/Building.elm @@ -77,7 +77,7 @@ update env msg ( model, pModel, sModel ) = in case msg of MachineMsg mmsg -> - case Debug.log "mmsg" mmsg of + case mmsg of StartDragging st ( x, y ) -> let ( sx, sy ) = From 3e80c2605109c29cb917bee75b18ff1359d5d256 Mon Sep 17 00:00:00 2001 From: CSchank Date: Thu, 7 Mar 2019 18:49:15 -0500 Subject: [PATCH 06/11] fix #69 by using recommended keys API --- src/Main.elm | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/src/Main.elm b/src/Main.elm index da166bf..15d3e74 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -31,8 +31,8 @@ type Msg = BMsg Building.Msg | SMsg Simulating.Msg | EMsg Exporting.Msg - | KeyPressed Int - | KeyReleased Int + | KeyPressed String + | KeyReleased String | WindowSize ( Int, Int ) | UrlChange Url | UrlRequest UrlRequest @@ -94,8 +94,8 @@ main = \model -> Sub.batch [ Browser.Events.onResize (\w h -> WindowSize ( w, h )) - , Browser.Events.onKeyDown (D.map KeyPressed (D.field "keyCode" D.int)) - , Browser.Events.onKeyUp (D.map KeyReleased (D.field "keyCode" D.int)) + , Browser.Events.onKeyDown (D.map KeyPressed (D.field "key" D.string)) + , Browser.Events.onKeyUp (D.map KeyReleased (D.field "key" D.string)) , Browser.Events.onVisibilityChange VisibilityChanged , case model.appModel.present.appState of Building m -> @@ -228,30 +228,30 @@ update msg model = ( model, Cmd.none ) KeyReleased k -> - if k == 16 then + if k == "Shift" then ( { model | environment = { oldEnvironment | holdingShift = False } }, Cmd.none ) - else if k == 91 then + else if k == "Meta" then ( { model | environment = { oldEnvironment | holdingMeta = False } }, Cmd.none ) - else if k == 17 then + else if k == "Control" then ( { model | environment = { oldEnvironment | holdingControl = False } }, Cmd.none ) else ( model, Cmd.none ) KeyPressed k -> - if k == 16 then + if k == "Shift" then ( { model | environment = { oldEnvironment | holdingShift = True } }, Cmd.none ) - else if k == 89 {- y -} || k == 90 {- z -} then + else if k == "y" || k == "z" then let doUndo = - (oldEnvironment.holdingControl || oldEnvironment.holdingMeta) && k == 90 + (oldEnvironment.holdingControl || oldEnvironment.holdingMeta) && k == "z" doRedo = - (oldEnvironment.holdingControl && k == 89) - || (oldEnvironment.holdingMeta && oldEnvironment.holdingShift && k == 90) + (oldEnvironment.holdingControl && k == "y") + || (oldEnvironment.holdingMeta && oldEnvironment.holdingShift && k == "z") in ( { model | appModel = @@ -267,11 +267,11 @@ update msg model = , Cmd.none ) - else if k == 91 then + else if k == "Meta" then --pressed meta key ( { model | environment = { oldEnvironment | holdingMeta = True } }, Cmd.none ) - else if k == 17 then + else if k == "Control" then --pressed control ( { model | environment = { oldEnvironment | holdingControl = True } }, Cmd.none ) {- else if k == 66 then From 0a16bb1a5a3570dcee68c13d4720304dedb22bd8 Mon Sep 17 00:00:00 2001 From: CSchank Date: Thu, 7 Mar 2019 18:50:23 -0500 Subject: [PATCH 07/11] use recommended part of API for keyboard in other modules --- src/Building.elm | 14 ++++------ src/Simulating.elm | 69 ++++++++++++++++++++++------------------------ 2 files changed, 39 insertions(+), 44 deletions(-) diff --git a/src/Building.elm b/src/Building.elm index 423eb83..9cc9995 100644 --- a/src/Building.elm +++ b/src/Building.elm @@ -34,7 +34,7 @@ type Msg | SaveStateName StateID String | SaveTransitionName TransitionID String | AddState ( Float, Float ) - | KeyPressed Int + | KeyPressed String | ToggleSnap | ChangeSnap Int | NoOp @@ -43,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)) ] @@ -426,7 +426,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 -> @@ -464,8 +464,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 @@ -527,14 +526,13 @@ update env msg ( model, pModel, sModel ) = _ -> ( ( 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 diff --git a/src/Simulating.elm b/src/Simulating.elm index 2d152ef..014f1b1 100644 --- a/src/Simulating.elm +++ b/src/Simulating.elm @@ -2,6 +2,7 @@ module Simulating exposing (HoverError, InputTape, Model(..), Msg(..), Persisten import Array exposing (Array) import Browser.Events +import Debug import Dict exposing (Dict) import Environment exposing (Environment) import Error exposing (..) @@ -17,7 +18,7 @@ import Tuple exposing (first, second) subscriptions : Model -> Sub Msg subscriptions model = - Browser.Events.onKeyDown (D.map KeyPressed (D.field "keyCode" D.int)) + Browser.Events.onKeyDown (D.map KeyPressed (D.field "key" D.string)) type alias PersistentModel = @@ -51,7 +52,7 @@ type Msg | AddNewTape | ChangeTape Int | ToggleStart StateID - | KeyPressed Int + | KeyPressed String | ChangeMachine MachineType | MachineMsg Machine.Msg | HoverErrorEnter Int @@ -325,8 +326,7 @@ update env msg ( model, pModel, sModel ) = ( ( Default tId -1 Nothing {- ??? -}, { pModel | currentStates = epsTrans oldMachine.transitionNames oldMachine.delta oldMachine.start }, sModel ), False, Cmd.none ) KeyPressed k -> - if k == 13 then - --pressed enter + if k == "Enter" then case model of Editing tId -> ( ( Default tId -1 Nothing, { pModel | currentStates = epsTrans oldMachine.transitionNames oldMachine.delta oldMachine.start }, sModel ), True, Cmd.none ) @@ -334,8 +334,7 @@ update env msg ( model, pModel, sModel ) = _ -> ( ( model, pModel, sModel ), False, Cmd.none ) - else if k == 8 then - --pressed delete + else if k == "Backspace" || k == "ArrowLeft" then case model of Editing tapeId -> let @@ -366,8 +365,7 @@ update env msg ( model, pModel, sModel ) = _ -> ( ( model, pModel, sModel ), False, Cmd.none ) - else if k == 39 then - --right arrow key + else if k == "ArrowRight" then case model of Default _ _ _ -> ( ( model, pModel, sModel ), False, Task.perform identity (Task.succeed <| Step) ) @@ -375,8 +373,7 @@ update env msg ( model, pModel, sModel ) = _ -> ( ( model, pModel, sModel ), False, Cmd.none ) - else if k == 37 then - --left arrow key + else if k == "ArrowLeft" then case model of Default tId _ hErr -> ( ( Default tId -1 hErr, { pModel | currentStates = sModel.machine.start }, sModel ), False, Cmd.none ) @@ -390,82 +387,82 @@ update env msg ( model, pModel, sModel ) = let charCode = case k of - 65 -> + "a" -> 0 - 83 -> + "s" -> 1 - 68 -> + "d" -> 2 - 70 -> + "f" -> 3 - 71 -> + "g" -> 4 - 72 -> + "h" -> 5 - 74 -> + "j" -> 6 - 75 -> + "k" -> 7 - 76 -> + "l" -> 8 - 81 -> + "q" -> 9 - 87 -> + "w" -> 10 - 69 -> + "e" -> 11 - 82 -> + "r" -> 12 - 84 -> + "t" -> 13 - 89 -> + "y" -> 14 - 85 -> + "u" -> 15 - 73 -> + "i" -> 16 - 79 -> + "o" -> 17 - 80 -> + "p" -> 18 - 90 -> + "z" -> 19 - 88 -> + "x" -> 20 - 67 -> + "c" -> 21 - 86 -> + "v" -> 22 - 66 -> + "b" -> 23 - 78 -> + "n" -> 24 - 77 -> + "m" -> 25 _ -> From bedee815939dc1e6a05ec08ca4f7665e37e50e26 Mon Sep 17 00:00:00 2001 From: CSchank Date: Thu, 7 Mar 2019 18:58:59 -0500 Subject: [PATCH 08/11] work on centring LaTeX keyboard, not perfect yet but better --- src/Simulating.elm | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/Simulating.elm b/src/Simulating.elm index 014f1b1..f0efa68 100644 --- a/src/Simulating.elm +++ b/src/Simulating.elm @@ -167,7 +167,16 @@ renderTape model input tapeSt tapeId selectedId inputAt showButtons = , latex (xpad * 0.9) (xpad * 0.7) "white" st AlignCentre |> move ( 0, 10.25 ) ] - |> move ( toFloat n * xpad, 0 ) + |> move + ( toFloat n * xpad + + (if not showButtons then + xpad / 2 + + else + 0 + ) + , 0 + ) |> notifyTap (ChangeTape tapeId) ) input From eef72b7c74691a826b09bffde4e95e60a7324616 Mon Sep 17 00:00:00 2001 From: CSchank Date: Thu, 7 Mar 2019 19:02:34 -0500 Subject: [PATCH 09/11] only deploy tagged builds --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 59739c7..7a587a0 100644 --- a/.travis.yml +++ b/.travis.yml @@ -29,4 +29,4 @@ jobs: stages: - test - name: deploy - if: "(branch = master) AND (type = push)" + if: "(branch = master) AND (tag is present)" From accd85ad585aefead44e7c6f98793f11e326bd73 Mon Sep 17 00:00:00 2001 From: CSchank Date: Thu, 7 Mar 2019 19:04:11 -0500 Subject: [PATCH 10/11] proper syntax for travis --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 7a587a0..545c962 100644 --- a/.travis.yml +++ b/.travis.yml @@ -29,4 +29,4 @@ jobs: stages: - test - name: deploy - if: "(branch = master) AND (tag is present)" + if: "(branch = master) AND (tag IS present)" From f2997f5791fed19c66a88ab671557eb568fa9571 Mon Sep 17 00:00:00 2001 From: CSchank Date: Thu, 7 Mar 2019 19:05:36 -0500 Subject: [PATCH 11/11] run elm-format --- src/Simulating.elm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Simulating.elm b/src/Simulating.elm index f0efa68..e087b36 100644 --- a/src/Simulating.elm +++ b/src/Simulating.elm @@ -168,7 +168,8 @@ renderTape model input tapeSt tapeId selectedId inputAt showButtons = |> move ( 0, 10.25 ) ] |> move - ( toFloat n * xpad + ( toFloat n + * xpad + (if not showButtons then xpad / 2