From 20ab664b89ea6a076d7f3f6476fe05a19ea53b38 Mon Sep 17 00:00:00 2001 From: cbossut Date: Sat, 18 Jan 2020 13:57:05 +0100 Subject: [PATCH 01/37] Collar animation --- playable.js | 23 ++++++++++++++++++++--- ports.js | 27 --------------------------- src/Engine.elm | 37 +++++++++++++++++++------------------ 3 files changed, 39 insertions(+), 48 deletions(-) diff --git a/playable.js b/playable.js index 3998eec..a4b4c32 100644 --- a/playable.js +++ b/playable.js @@ -4,6 +4,12 @@ function prepare(model, rate = 1) { model.paused = true model.pauseOffset = 0 model.length = model.length + if (model.view && model.id) { + model.view = SVG.adopt(document.getElementById(model.id)) + /* model.once + ? model.view.animate(model.length * 1000).transform({rotation:360, cx:0, cy:0}).pause() + : */model.view.animate(model.length * 1000).transform({rotation:360, cx:0, cy:0}).loop().pause() + } if (model.soundName) { model.player = new Tone.Player(buffers[model.soundName]).toMaster() model.duration = model.player.buffer.duration @@ -20,7 +26,11 @@ function prepare(model, rate = 1) { model.rate = (rate * model.duration / model.length) || 1 // TODO when preparing top collar, no model.length model.durs = model.collar.beads.map(v => v.length / model.rate) let totalDur = model.durs.reduce((a,b) => a+b, 0) - model.players = model.collar.beads.map(v => prepare(v, model.rate)) + model.players = model.collar.beads.map((v,i) => { + v.id = model.baseId + i +// v.once = true + return prepare(v, model.rate) + }) model.clocks = model.players.map((subModel,i,a) => { return new Tone.Clock(t => { if (model.paused && (model.progPause <= t)) return; @@ -29,7 +39,7 @@ function prepare(model, rate = 1) { model.current = i let prec = (i + a.length - 1) % a.length play(subModel, t, subModel, model.volume, model.mute) - pause(a[prec], t, model.paused) // hence force recalculation + pause(a[prec], t, model.paused, true) // hence force recalculation if (model.paused) pause(subModel, model.progPause) // and pause next // console.log(i, Math.min(model.players[i].duration - model.players[i].pauseOffset, model.players[i].pauseOffset)) // TODO Small drift… }, 1/totalDur) @@ -44,6 +54,9 @@ function play(model, t, newModel = {}, volume = 1, mute = false) { // TODO What model.volume = newModel.volume || 1 // TODO cf first TODO model.mute = newModel.mute || false // TODO cf first TODO model.startTime = t - model.pauseOffset / model.rate + if (model.view) { + Tone.Draw.schedule(() => model.view.animate().play(), t) + } if (model.soundName && model.player.output) { if (mute || model.mute) model.player.mute = true else model.player.volume.value = ((model.volume * volume) - 1) * 60 @@ -71,10 +84,13 @@ function play(model, t, newModel = {}, volume = 1, mute = false) { // TODO What } } -function pause(model, t, force = false) { +function pause(model, t, force = false, clocked = false) { if (model.paused && !force) return; model.paused = true model.pauseOffset = ((t - model.startTime) * model.rate) + if (model.view){//} && !clocked) { + Tone.Draw.schedule(() => model.view.animate().pause().at((model.pauseOffset/model.length/model.rate) % 1), t) + } if (model.soundName && model.player.output) { model.player.stop(t) } @@ -94,6 +110,7 @@ function pause(model, t, force = false) { } function stop(model) { + if (model.view) model.view.animate().play().finish().stop() if (model.soundName) model.player.stop().dispose() if (model.mobile) model.gears.map(stop) if (model.collar) { diff --git a/ports.js b/ports.js index 3834771..63c02da 100644 --- a/ports.js +++ b/ports.js @@ -42,7 +42,6 @@ function engine(o) { if (playing.clocks) stop(playing) else for ( id in playing) { stop(playing[id]) - playing[id].view.animate().play().finish() } playing = {} break; @@ -87,40 +86,14 @@ function engine(o) { } } -function playTopCollar(beads, baseId) { - let model = playing - , part = [] - , t = 0 - for (let i in beads) { - part.push([t, i]) - t += beads[i].length - beads[i].id = baseId + i - } - model.beads = beads.map(v => prepare(v)) - model.player = new Tone.Part( ((t, i) => {model.beads[i].once(t)}), part ) - model.player.loopEnd = t - model.player.loop = true - model.player.start() - Tone.Transport.start() -} - -function playPauseTopCollar(beads) { - Tone.Transport.pause() - Tone.Transport.start() -} - function playPause(model,t) { if (!playing[model.id]) { playing[model.id] = prepare(model) - playing[model.id].view = SVG.adopt(document.getElementById(model.id)) - playing[model.id].view.animate(model.length * 1000).transform({rotation:360, cx:0, cy:0}).loop() } if (playing[model.id].paused) { play(playing[model.id], t, model) - playing[model.id].view.animate().play() } else { pause(playing[model.id], t) - playing[model.id].view.animate().pause() } } diff --git a/src/Engine.elm b/src/Engine.elm index 759f064..c3f3ed3 100644 --- a/src/Engine.elm +++ b/src/Engine.elm @@ -70,7 +70,7 @@ playPause : Coll Geer -> List (Id Geer) -> E.Value playPause coll els = E.object [ ( "action", E.string "playPause" ) - , ( "gears", E.list (encodeGear coll) els ) + , ( "gears", E.list (encodeGear True coll) els ) ] @@ -84,7 +84,7 @@ playCollar collar = E.object [ ( "action", E.string "playCollar" ) , ( "baseId", E.string <| String.dropRight 1 <| Collar.toUID 0 ) - , ( "collar", encodeCollar collar ) + , ( "collar", encodeCollar collar True ) ] @@ -134,25 +134,26 @@ volumeChanged id volume e = Nothing -encodeWheel : Wheel -> List ( String, E.Value ) -encodeWheel w = +encodeWheel : Wheel -> Bool -> List ( String, E.Value ) +encodeWheel w hasView = [ ( "mute", E.bool w.mute ) , ( "volume", E.float <| clamp 0 1 w.volume ) + , ( "view", E.bool hasView ) ] ++ (case Wheel.getContent { wheel = w } of Content.S s -> [ ( "soundName", E.string <| Sound.toString s ) ] Content.M m -> - [ ( "mobile", encodeMobile m ) ] + [ ( "mobile", encodeMobile m False ) ] Content.C c -> - [ ( "collar", encodeCollar c ) ] + [ ( "collar", encodeCollar c False ) ] ) -encodeGear : Coll Geer -> Id Geer -> E.Value -encodeGear coll id = +encodeGear : Bool -> Coll Geer -> Id Geer -> E.Value +encodeGear hasView coll id = let g = Coll.get id coll @@ -171,30 +172,30 @@ encodeGear coll id = ([ ( "id", E.string <| uid ) , ( "length", E.float length ) ] - ++ encodeWheel g.wheel + ++ encodeWheel g.wheel hasView ) -encodeMobile : Mobeel -> E.Value -encodeMobile { motor, gears } = +encodeMobile : Mobeel -> Bool -> E.Value +encodeMobile { motor, gears } hasView = E.object [ ( "length", E.float <| Harmo.getLengthId motor gears ) - , ( "gears", E.list (encodeGear gears) <| Motor.getMotored motor gears ) + , ( "gears", E.list (encodeGear hasView gears) <| Motor.getMotored motor gears ) ] -encodeCollar : Colleer -> E.Value -encodeCollar c = +encodeCollar : Colleer -> Bool -> E.Value +encodeCollar c hasView = E.object [ ( "length", E.float <| Collar.getCumulLengthAt c.matrice c ) , ( "loopStart", E.float c.loop ) - , ( "beads", E.list encodeBead <| Collar.getBeads c ) + , ( "beads", E.list (encodeBead hasView) <| Collar.getBeads c ) ] -encodeBead : Beed -> E.Value -encodeBead b = +encodeBead : Bool -> Beed -> E.Value +encodeBead hasView b = E.object (( "length", E.float b.length ) - :: encodeWheel b.wheel + :: encodeWheel b.wheel hasView ) From 111e9eadad59908c197293dbd24663d806f20300 Mon Sep 17 00:00:00 2001 From: cbossut Date: Sat, 18 Jan 2020 15:03:18 +0100 Subject: [PATCH 02/37] factorize Move in Mobile editor --- src/Editor/Mobile.elm | 58 ++++++++++++++++++++----------------------- 1 file changed, 27 insertions(+), 31 deletions(-) diff --git a/src/Editor/Mobile.elm b/src/Editor/Mobile.elm index 7099d67..ac88f7e 100644 --- a/src/Editor/Mobile.elm +++ b/src/Editor/Mobile.elm @@ -1038,22 +1038,9 @@ manageInteractEvent event model mobile = { return | outMsg = interactNav event <| Content.M mobile } Move -> - -- FIXME copy of edit move - case ( event.item, event.action, model.dragging ) of - -- MOVE - ( IWheel (G id), Interact.Dragged oldPos newPos _, _ ) -> - let - gearUp = - Gear.update <| Gear.Move <| Vec.sub newPos oldPos - in - { return - | model = { model | dragging = Moving } - , mobile = { mobile | gears = Coll.update id gearUp mobile.gears } - , toUndo = Group - } - - ( _, Interact.DragEnded _, Moving ) -> - { return | model = { model | dragging = NoDrag }, toUndo = Do } + case interactMove event model mobile of + Just ret -> + { return | model = ret.model, mobile = ret.mobile, toUndo = ret.toUndo } _ -> return @@ -1085,21 +1072,9 @@ manageInteractEvent event model mobile = -- EDIT -------- Edit -> - case ( event.item, event.action, model.dragging ) of - -- MOVE - ( IWheel (G id), Interact.Dragged oldPos newPos _, _ ) -> - let - gearUp = - Gear.update <| Gear.Move <| Vec.sub newPos oldPos - in - { return - | model = { model | dragging = Moving } - , mobile = { mobile | gears = Coll.update id gearUp mobile.gears } - , toUndo = Group - } - - ( _, Interact.DragEnded _, Moving ) -> - { return | model = { model | dragging = NoDrag }, toUndo = Do } + case interactMove event model mobile of + Just ret -> + { return | model = ret.model, mobile = ret.mobile, toUndo = ret.toUndo } _ -> { return | model = { model | common = interactSelectEdit event model.common } } @@ -1303,3 +1278,24 @@ interactHarmonize event model mobile = _ -> return + + +interactMove : Interact.Event Interactable -> Model -> Mobeel -> Maybe { model : Model, mobile : Mobeel, toUndo : ToUndo } +interactMove event model mobile = + case ( event.item, event.action, model.dragging ) of + ( IWheel (G id), Interact.Dragged oldPos newPos _, _ ) -> + let + gearUp = + Gear.update <| Gear.Move <| Vec.sub newPos oldPos + in + Just + { model = { model | dragging = Moving } + , mobile = { mobile | gears = Coll.update id gearUp mobile.gears } + , toUndo = Group + } + + ( _, Interact.DragEnded _, Moving ) -> + Just { model = { model | dragging = NoDrag }, mobile = mobile, toUndo = Do } + + _ -> + Nothing From 9b2f56d3d136c38e43016664e1da54651862aef8 Mon Sep 17 00:00:00 2001 From: cbossut Date: Sat, 18 Jan 2020 21:35:05 +0100 Subject: [PATCH 03/37] Click n drag from loaded sound to create Gear --- src/Doc.elm | 21 ++++---- src/Editor/Collar.elm | 78 +++++++++++++++------------- src/Editor/Common.elm | 3 +- src/Editor/Mobile.elm | 118 ++++++++++++++++++++++++++++-------------- src/Main.elm | 9 +++- 5 files changed, 140 insertions(+), 89 deletions(-) diff --git a/src/Doc.elm b/src/Doc.elm index 7b97129..eae9a12 100644 --- a/src/Doc.elm +++ b/src/Doc.elm @@ -14,6 +14,7 @@ import Element.Font as Font import Element.Input as Input import Engine import Html.Attributes +import Interact import Json.Encode as E import PanSvg import Sound exposing (Sound) @@ -68,11 +69,11 @@ type Msg | Redo | View (List ( String, Identifier )) | ChangedMode Mode - | SoundClicked Sound | AddContent WContent | KeyPressed Shortcut | MobileMsg MEditor.Msg | CollarMsg CEditor.Msg + | InteractMsg (Interact.Msg Editors.Interactable) update : Msg -> Doc -> ( Doc, Cmd Msg ) @@ -155,18 +156,10 @@ update msg doc = _ -> Debug.log "IMPOSSIBLE Mode for wrong editor" ( doc, Cmd.none ) - SoundClicked sound -> - case doc.editor of - M _ -> - update (MobileMsg <| MEditor.SoundClicked sound) doc - - C _ -> - update (CollarMsg <| CEditor.SoundClicked sound) doc - AddContent content -> case doc.editor of M _ -> - update (MobileMsg <| MEditor.NewGear content) doc + update (MobileMsg <| MEditor.NewGear MEditor.defaultAddPos content) doc C _ -> update (CollarMsg <| CEditor.NewBead content) doc @@ -305,6 +298,14 @@ update msg doc = _ -> Debug.log "IMPOSSIBLE CollarMsg while viewing no collar" ( doc, Cmd.none ) + InteractMsg subMsg -> + case doc.editor of + M e -> + update (MobileMsg <| MEditor.InteractMsg <| subMsg) doc + + C e -> + update (CollarMsg <| CEditor.InteractMsg <| subMsg) doc + subs : Doc -> List (Sub Msg) subs doc = diff --git a/src/Editor/Collar.elm b/src/Editor/Collar.elm index afae2e1..6ba794d 100644 --- a/src/Editor/Collar.elm +++ b/src/Editor/Collar.elm @@ -69,7 +69,6 @@ type Msg | CursorRight | CursorLeft | ToggleEngine - | SoundClicked Sound | NewBead (Content Wheel) | DeleteBead Int | PackBead @@ -119,15 +118,6 @@ update msg ( model, collar ) = ToggleEngine -> { return | toEngine = Just <| Engine.playCollar collar } - SoundClicked s -> - case model.mode of - CommonMode (ChangeSound (B i)) -> - update (WheelMsg ( i, Wheel.ChangeContent <| Content.S s )) - ( { model | mode = CommonMode Normal }, collar ) - - _ -> - update (NewBead <| Content.S s) ( model, collar ) - NewBead c -> let colorGen = @@ -348,35 +338,49 @@ manageInteractEvent event model collar = CommonMode Nav -> { return | outMsg = interactNav event <| Content.C collar } - CommonMode (ChangeSound _) -> - return + CommonMode (ChangeSound (B i)) -> + case ( event.item, event.action ) of + ( ISound s, Interact.Clicked _ ) -> + update (WheelMsg ( i, Wheel.ChangeContent <| Content.S s )) + ( { model | mode = CommonMode Normal }, collar ) + + _ -> + return CommonMode Normal -> - case model.tool of - Play on -> - --TODO Factorize - let - scale = - PanSvg.getScale model.svg - in - case ( event.item, event.action ) of - -- MUTE - ( IWheel (B i), Interact.Clicked _ ) -> - let - w = - (Collar.get i collar).wheel + case ( event.item, event.action ) of + ( ISound s, Interact.Clicked _ ) -> + update (NewBead <| Content.S s) ( model, collar ) - newMute = - not w.mute + _ -> + case model.tool of + Play on -> + --TODO Factorize + let + scale = + PanSvg.getScale model.svg in - { return - | collar = Collar.updateBead i (\b -> { b | wheel = { w | mute = newMute } }) collar - , toUndo = Do - , toEngine = Just <| Engine.mutedBead i newMute - } - - _ -> - return + case ( event.item, event.action ) of + -- MUTE + ( IWheel (B i), Interact.Clicked _ ) -> + let + w = + (Collar.get i collar).wheel + + newMute = + not w.mute + in + { return + | collar = Collar.updateBead i (\b -> { b | wheel = { w | mute = newMute } }) collar + , toUndo = Do + , toEngine = Just <| Engine.mutedBead i newMute + } + + _ -> + return + + Edit -> + { return | model = { model | common = interactSelectEdit event model.common } } - Edit -> - { return | model = { model | common = interactSelectEdit event model.common } } + _ -> + return diff --git a/src/Editor/Common.elm b/src/Editor/Common.elm index 305c4a4..a8a3163 100644 --- a/src/Editor/Common.elm +++ b/src/Editor/Common.elm @@ -12,7 +12,7 @@ import Element.Font as Font import Element.Input as Input import Harmony as Harmo import Interact -import Sound +import Sound exposing (Sound) type alias CommonModel = @@ -76,6 +76,7 @@ type Interactable = ISurface | IWheel Identifier | IResizeHandle Identifier Bool + | ISound Sound fromWheelInteractable : Wheel.Interactable Identifier -> Interactable diff --git a/src/Editor/Mobile.elm b/src/Editor/Mobile.elm index ac88f7e..a12b5a6 100644 --- a/src/Editor/Mobile.elm +++ b/src/Editor/Mobile.elm @@ -25,9 +25,11 @@ import Motor import PanSvg import Random import Round -import Sound exposing (Sound) +import Sound import TypedSvg as S +import TypedSvg.Attributes as SA import TypedSvg.Core as Svg exposing (Svg) +import TypedSvg.Types exposing (Length(..), Opacity(..)) type alias Model = @@ -35,6 +37,7 @@ type alias Model = , tool : Tool , mode : Mode , link : Maybe LinkInfo + , shallow : Maybe ( Vec2, Float ) , engine : Engine , interact : Interact.State Interactable , common : CommonModel @@ -94,6 +97,7 @@ init mayMobile mayShared = , tool = Play False , mode = CommonMode Normal , link = Nothing + , shallow = Nothing , engine = Engine.init , interact = Interact.init , common = commonInit <| Maybe.map Tuple.first mayShared @@ -115,9 +119,8 @@ type Msg | PlayGear (Id Geer) | StopGear (Id Geer) -- - | SoundClicked Sound | CopyGear (Id Geer) - | NewGear (Content Wheel) + | NewGear Vec2 (Content Wheel) | DeleteGear (Id Geer) | PackGear | UnpackGear ( Wheel, Float ) Bool -- True for new, False for Content @@ -214,32 +217,13 @@ update msg ( model, mobile ) = StopGear id -> { return | model = { model | engine = Engine.init }, toEngine = Just Engine.stop } - SoundClicked s -> - case model.mode of - CommonMode (ChangeSound (G id)) -> - let - group = - Harmo.getHarmonicGroup (Coll.idMap id) mobile.gears - - chSound = - Wheel.update <| Wheel.ChangeContent <| Content.S s - in - { return - | mobile = { mobile | gears = List.foldl (\el -> Coll.update el chSound) mobile.gears group } - , toUndo = Do - , model = { model | mode = CommonMode Normal } - } - - _ -> - update (NewGear <| Content.S s) ( model, mobile ) - CopyGear id -> { return | mobile = { mobile | gears = Gear.copy id mobile.gears }, toUndo = Do } - NewGear content -> + NewGear p content -> let ( id, gears ) = - Coll.insertTellId (Mobile.gearFromContent content defaultAddPos) mobile.gears + Coll.insertTellId (Mobile.gearFromContent content p) mobile.gears colorGen = Random.map (\f -> Color.hsl f 1 0.5) <| Random.float 0 1 @@ -753,6 +737,23 @@ viewContent ( model, mobile ) = _ -> [] ) + ++ (case model.shallow of + Just ( p, l ) -> + [ S.circle + [ SA.cx <| Num <| Vec.getX p + , SA.cy <| Num <| Vec.getY p + , SA.r <| Num (l / 2) + , SA.strokeWidth <| Num <| l / 30 + , SA.stroke Color.black + , SA.strokeOpacity <| Opacity 0.5 + , SA.fillOpacity <| Opacity 0 + ] + [] + ] + + Nothing -> + [] + ) viewDetails : Model -> Mobeel -> List (Element Msg) @@ -1057,27 +1058,64 @@ manageInteractEvent event model mobile = _ -> return - CommonMode (ChangeSound _) -> - return + CommonMode (ChangeSound (G id)) -> + case ( event.item, event.action ) of + ( ISound s, Interact.Clicked _ ) -> + let + group = + Harmo.getHarmonicGroup (Coll.idMap id) mobile.gears + + chSound = + Wheel.update <| Wheel.ChangeContent <| Content.S s + in + { return + | mobile = { mobile | gears = List.foldl (\el -> Coll.update el chSound) mobile.gears group } + , toUndo = Do + , model = { model | mode = CommonMode Normal } + } + + _ -> + return CommonMode Normal -> - case model.tool of - -- PLAY -------- - Play on -> - interactPlay on event model mobile + case ( event.item, event.action ) of + ( ISound s, Interact.Clicked _ ) -> + update (NewGear defaultAddPos <| Content.S s) ( model, mobile ) - -- LINK -------- - Harmonize -> - interactHarmonize event model mobile + ( ISound s, Interact.Dragged _ p _ ) -> + { return + | model = { model | shallow = Just ( p, Sound.length s ) } + } - -- EDIT -------- - Edit -> - case interactMove event model mobile of - Just ret -> - { return | model = ret.model, mobile = ret.mobile, toUndo = ret.toUndo } + ( ISound s, Interact.DragEnded True ) -> + case model.shallow of + Just ( p, _ ) -> + update (NewGear p <| Content.S s) ( { model | shallow = Nothing }, mobile ) + + Nothing -> + return + + _ -> + case model.tool of + -- PLAY -------- + Play on -> + interactPlay on event model mobile - _ -> - { return | model = { model | common = interactSelectEdit event model.common } } + -- LINK -------- + Harmonize -> + interactHarmonize event model mobile + + -- EDIT -------- + Edit -> + case interactMove event model mobile of + Just ret -> + { return | model = ret.model, mobile = ret.mobile, toUndo = ret.toUndo } + + _ -> + { return | model = { model | common = interactSelectEdit event model.common } } + + _ -> + return interactPlay : Bool -> Interact.Event Interactable -> Model -> Mobeel -> Return diff --git a/src/Main.elm b/src/Main.elm index 9bde57b..6bebbf1 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -22,6 +22,7 @@ import File exposing (File) import File.Download as DL import File.Select as Select import Http +import Interact import Json.Decode as D import Keys import NaturalOrdering as Natural @@ -533,7 +534,13 @@ viewLoaded model = soundView : Sound -> Element Msg soundView s = el - [ onClick <| DocMsg <| Doc.SoundClicked s ] + (List.map + (Element.htmlAttribute + >> (Element.mapAttribute <| DocMsg << Doc.InteractMsg) + ) + <| + Interact.draggableEvents (Editors.ISound s) + ) (text (Sound.toString s)) From 37df4cfae1a9abeefadec2b002dc015d92279c5b Mon Sep 17 00:00:00 2001 From: cbossut Date: Sat, 18 Jan 2020 21:38:15 +0100 Subject: [PATCH 04/37] Group Wheel creation and random color --- src/Editor/Collar.elm | 2 +- src/Editor/Mobile.elm | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Editor/Collar.elm b/src/Editor/Collar.elm index 6ba794d..ffe7fc6 100644 --- a/src/Editor/Collar.elm +++ b/src/Editor/Collar.elm @@ -125,7 +125,7 @@ update msg ( model, collar ) = in { return | collar = Collar.add model.cursor (Collar.beadFromContent c) collar - , toUndo = Do + , toUndo = Group , model = { model | cursor = model.cursor + 1 } , cmd = Random.generate (\color -> WheelMsg ( model.cursor, Wheel.ChangeColor color )) colorGen } diff --git a/src/Editor/Mobile.elm b/src/Editor/Mobile.elm index a12b5a6..cbb0e1b 100644 --- a/src/Editor/Mobile.elm +++ b/src/Editor/Mobile.elm @@ -230,7 +230,7 @@ update msg ( model, mobile ) = in { return | mobile = { mobile | gears = gears } - , toUndo = Do + , toUndo = Group , model = { model | svg = PanSvg.centerZoom (Mobile.gearPosSize id gears) model.svg } , cmd = Random.generate (\color -> WheelMsg ( id, Wheel.ChangeColor color )) colorGen } From 5f06208df8cc557775a8215ba798b023d37203c0 Mon Sep 17 00:00:00 2001 From: cbossut Date: Sat, 18 Jan 2020 22:31:33 +0100 Subject: [PATCH 05/37] Can move if click on tick or symbol --- src/Data/Wheel.elm | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/src/Data/Wheel.elm b/src/Data/Wheel.elm index 846b3ae..2301f98 100644 --- a/src/Data/Wheel.elm +++ b/src/Data/Wheel.elm @@ -135,25 +135,25 @@ view w pos length style id uid = ([ SA.transform [ Translate (getX pos) (getY pos) ] ] ++ Interact.hoverEvents (IWheel id) ) - ([ S.g [ Html.Attributes.id uid ] + ([ S.g (Html.Attributes.id uid :: Interact.draggableEvents (IWheel id)) ([ S.circle - ([ SA.cx <| Num 0 - , SA.cy <| Num 0 - , SA.r <| Num (length / 2) - , SA.stroke <| + [ SA.cx <| Num 0 + , SA.cy <| Num 0 + , SA.r <| Num (length / 2) + , SA.stroke <| if style.motor then Color.red else Color.black - , SA.strokeWidth <| + , SA.strokeWidth <| Num <| if style.mod == Selectable then tickW * 2 else tickW - , SA.strokeDasharray <| + , SA.strokeDasharray <| if style.dashed then String.fromFloat (circum / 40 * 3 / 4) ++ "," @@ -161,7 +161,7 @@ view w pos length style id uid = else "" - , SA.fill <| + , SA.fill <| if w.mute then Fill Color.white @@ -170,10 +170,8 @@ view w pos length style id uid = else Fill w.color - , SA.fillOpacity <| Opacity (0.2 + 0.8 * w.volume) - ] - ++ Interact.draggableEvents (IWheel id) - ) + , SA.fillOpacity <| Opacity (0.2 + 0.8 * w.volume) + ] [] , S.rect [ SA.width <| Num tickW From 891cbbcb67edce5d1f0918eff7c23436a0a87ef8 Mon Sep 17 00:00:00 2001 From: cbossut Date: Wed, 22 Jan 2020 11:23:33 +0100 Subject: [PATCH 06/37] minor clean --- src/Doc.elm | 1 - src/Editor/Collar.elm | 1 - src/Editor/Common.elm | 1 + 3 files changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Doc.elm b/src/Doc.elm index eae9a12..88d4430 100644 --- a/src/Doc.elm +++ b/src/Doc.elm @@ -17,7 +17,6 @@ import Html.Attributes import Interact import Json.Encode as E import PanSvg -import Sound exposing (Sound) import Url exposing (Url) diff --git a/src/Editor/Collar.elm b/src/Editor/Collar.elm index ffe7fc6..380cf45 100644 --- a/src/Editor/Collar.elm +++ b/src/Editor/Collar.elm @@ -15,7 +15,6 @@ import Json.Encode as E import Math.Vector2 as Vec exposing (vec2) import PanSvg import Random -import Sound exposing (Sound) import TypedSvg as S import TypedSvg.Attributes as SA import TypedSvg.Core as Svg exposing (Svg) diff --git a/src/Editor/Common.elm b/src/Editor/Common.elm index a8a3163..3d4abe2 100644 --- a/src/Editor/Common.elm +++ b/src/Editor/Common.elm @@ -162,6 +162,7 @@ viewDetailsColumn = ] +viewDetailChangingSound : Identifier -> Content Wheel -> msg -> List (Element msg) viewDetailChangingSound id c msg = [ column [ height fill, Bg.color (rgb 0.5 0.2 0), Font.color (rgb 1 1 1), spacing 20, padding 10 ] <| [ text <| getNameFromContent id c From 6357c4a9aea170e8530fc57ebcc43d7e55597fbb Mon Sep 17 00:00:00 2001 From: cbossut Date: Wed, 22 Jan 2020 12:35:35 +0100 Subject: [PATCH 07/37] PreListenning sounds --- src/Main.elm | 88 ++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 65 insertions(+), 23 deletions(-) diff --git a/src/Main.elm b/src/Main.elm index 6bebbf1..28d81b3 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -21,6 +21,9 @@ import Element.Input as Input import File exposing (File) import File.Download as DL import File.Select as Select +import Html +import Html.Attributes as Attr +import Html.Events as Events import Http import Interact import Json.Decode as D @@ -30,6 +33,7 @@ import Result exposing (Result) import Set exposing (Set) import Sound exposing (Sound) import Url exposing (Url) +import Url.Builder port loadSound : String -> Cmd msg @@ -66,7 +70,7 @@ main = type alias Model = { connected : Bool , currentUrl : Url.Url - , soundList : Set String + , soundList : Dict String Bool , loadedSoundList : List Sound , savesList : Set String , doc : Doc @@ -92,7 +96,7 @@ init screen url _ = ( Model False url - Set.empty + Dict.empty [] Set.empty (Doc.init <| Just url) @@ -111,6 +115,7 @@ init screen url _ = type Msg = GotSoundList (Result Http.Error String) | RequestSoundList + | PreListening String Bool | RequestSoundLoad String | RequestSoundDownload String | RequestSavesList @@ -135,7 +140,11 @@ update msg model = case result of Ok stringList -> ( { model - | soundList = Set.union model.soundList <| Set.fromList <| String.split "\\" stringList + | soundList = + Dict.union model.soundList <| + Dict.fromList <| + List.map (\str -> ( str, False )) <| + String.split "\\" stringList , connected = True } , Cmd.none @@ -214,7 +223,7 @@ update msg model = RequestSoundLoad n -> -- TODO handle no response ( model - , if Set.member n model.soundList then + , if Dict.member n model.soundList then loadSound n else @@ -223,7 +232,7 @@ update msg model = RequestSoundDownload n -> ( model - , if Set.member n model.soundList then + , if Dict.member n model.soundList then DL.url <| Url.toString model.currentUrl ++ "sons/" ++ n else @@ -271,6 +280,9 @@ update msg model = (f :: lf) ) + PreListening s p -> + ( { model | soundList = Dict.update s (Maybe.map <| always p) model.soundList }, Cmd.none ) + ChangedExplorerTab tab -> ( { model | fileExplorerTab = tab }, Cmd.none ) @@ -496,26 +508,56 @@ viewSounds model = } , column [ width fill, height <| fillPortion 1, spacing 5, padding 2, scrollbarY ] <| (List.map - (\s -> - el - [ onClick <| - if model.mode == Downloading then - RequestSoundDownload s - - else - RequestSoundLoad s - , Font.color <| - if List.any ((==) s) <| List.map Sound.toString model.loadedSoundList then - rgb 0.2 0.8 0.2 - - else - rgb 1 1 1 - ] - (text s) + (\( s, playing ) -> + row [ spacing 5 ] + ([ Input.button + [ Font.color <| + if List.any ((==) s) <| List.map Sound.toString model.loadedSoundList then + rgb 0.2 0.8 0.2 + + else + rgb 1 1 1 + ] + { label = text s + , onPress = + Just <| + if model.mode == Downloading then + RequestSoundDownload s + + else + RequestSoundLoad s + } + , Input.button [] + -- Charset ref https://www.w3schools.com/charsets/ref_utf_geometric.asp + { label = + text <| + if playing then + "◼" + + else + "▶" + , onPress = Just <| PreListening s <| not playing + } + ] + ++ (if playing then + [ Element.html <| + Html.audio + [ Attr.hidden True + , Attr.src <| Debug.log "url" <| Url.Builder.relative [ "sons", s ] [] + , Attr.autoplay True + , Events.on "ended" <| D.succeed <| PreListening s False + ] + [] + ] + + else + [] + ) + ) ) <| - List.sortWith Natural.compare <| - Set.toList model.soundList + List.sortWith (\t1 t2 -> Natural.compare (Tuple.first t1) (Tuple.first t2)) <| + Dict.toList model.soundList ) ] ] From 90743ae2968132d3e205138b0323fe2db93347a1 Mon Sep 17 00:00:00 2001 From: cbossut Date: Wed, 22 Jan 2020 14:59:56 +0100 Subject: [PATCH 08/37] Try to fix late mute in collar --- playable.js | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/playable.js b/playable.js index a4b4c32..9ecf767 100644 --- a/playable.js +++ b/playable.js @@ -12,6 +12,7 @@ function prepare(model, rate = 1) { } if (model.soundName) { model.player = new Tone.Player(buffers[model.soundName]).toMaster() + setVolume(model) model.duration = model.player.buffer.duration model.player.playbackRate = model.rate = rate * model.duration / model.length model.player.loop = true @@ -58,8 +59,7 @@ function play(model, t, newModel = {}, volume = 1, mute = false) { // TODO What Tone.Draw.schedule(() => model.view.animate().play(), t) } if (model.soundName && model.player.output) { - if (mute || model.mute) model.player.mute = true - else model.player.volume.value = ((model.volume * volume) - 1) * 60 + setVolume(model, volume, mute) model.player.start(t, model.pauseOffset) } if (model.mobile) { From 0f7f15894f2ab5bcc670749b5747bfb81bbcc830 Mon Sep 17 00:00:00 2001 From: cbossut Date: Wed, 22 Jan 2020 16:41:58 +0100 Subject: [PATCH 09/37] Pan OKLM --- src/Doc.elm | 9 +++++++++ src/Keys.elm | 3 ++- src/Main.elm | 23 +++++++++++++++++++++++ src/PanSvg.elm | 36 ++++++++++++++++++++++++++++++++++++ 4 files changed, 70 insertions(+), 1 deletion(-) diff --git a/src/Doc.elm b/src/Doc.elm index 88d4430..e558706 100644 --- a/src/Doc.elm +++ b/src/Doc.elm @@ -70,6 +70,7 @@ type Msg | ChangedMode Mode | AddContent WContent | KeyPressed Shortcut + | DirectionRepeat PanSvg.Direction | MobileMsg MEditor.Msg | CollarMsg CEditor.Msg | InteractMsg (Interact.Msg Editors.Interactable) @@ -205,6 +206,14 @@ update msg doc = _ -> ( doc, Cmd.none ) + DirectionRepeat dir -> + case doc.editor of + M editor -> + update (MobileMsg <| MEditor.SvgMsg <| PanSvg.Pan dir) doc + + _ -> + ( doc, Cmd.none ) + MobileMsg subMsg -> case ( doc.editor, getViewing doc ) of ( M editor, Content.M mobile ) -> diff --git a/src/Keys.elm b/src/Keys.elm index 0b7ea01..64b0ddc 100644 --- a/src/Keys.elm +++ b/src/Keys.elm @@ -17,6 +17,7 @@ init = type Event = Press String | Hold (Set String) + | Repeat String type Msg @@ -32,7 +33,7 @@ update msg state = hold = Set.insert code state in - ( hold, [ Hold hold ] ) + ( hold, [ Hold hold, Repeat code ] ) HoldUp code -> let diff --git a/src/Main.elm b/src/Main.elm index 28d81b3..8977d42 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -29,6 +29,7 @@ import Interact import Json.Decode as D import Keys import NaturalOrdering as Natural +import PanSvg import Result exposing (Result) import Set exposing (Set) import Sound exposing (Sound) @@ -353,6 +354,18 @@ update msg model = Nothing -> ( m, c ) + + Keys.Repeat code -> + case Dict.get code keyCodeToDirection of + Just dir -> + let + ( doc, cmd ) = + Doc.update (Doc.DirectionRepeat dir) m.doc + in + ( { m | doc = doc }, Cmd.batch [ c, Cmd.map DocMsg cmd ] ) + + Nothing -> + ( m, c ) ) ( { model | keys = state }, Cmd.none ) events @@ -403,6 +416,16 @@ keyCodeToShortcut = ] +keyCodeToDirection : Dict String PanSvg.Direction +keyCodeToDirection = + Dict.fromList + [ ( "KeyO", PanSvg.Up ) + , ( "KeyK", PanSvg.Left ) + , ( "KeyL", PanSvg.Down ) + , ( "Semicolon", PanSvg.Right ) + ] + + -- VIEW diff --git a/src/PanSvg.elm b/src/PanSvg.elm index 9eb69ad..8ec5113 100644 --- a/src/PanSvg.elm +++ b/src/PanSvg.elm @@ -73,6 +73,14 @@ init = type Msg = SVGSize (Result D.Error Size) | Zoom Float ( Float, Float ) + | Pan Direction + + +type Direction + = Left + | Right + | Up + | Down update : Msg -> Model -> Model @@ -108,6 +116,34 @@ update msg model = in { model | viewPos = { c = nC, smallestSize = nS } } + Pan dir -> + let + viewPos = + model.viewPos + + d = + viewPos.smallestSize / 50 + in + { model + | viewPos = + { viewPos + | c = + Vec.add model.viewPos.c <| + case dir of + Left -> + vec2 -d 0 + + Right -> + vec2 d 0 + + Up -> + vec2 0 -d + + Down -> + vec2 0 d + } + } + sub : Sub Msg sub = From 31995629f80a4aacbe07fbb3a68a34b76215954f Mon Sep 17 00:00:00 2001 From: cbossut Date: Wed, 22 Jan 2020 18:59:59 +0100 Subject: [PATCH 10/37] Simple Record --- lib/recorder.js | 357 ++++++++++++++++++++++++++++++++++++++++++ ports.html | 1 + ports.js | 13 ++ src/Doc.elm | 2 +- src/Editor/Mobile.elm | 72 +++++++-- 5 files changed, 430 insertions(+), 15 deletions(-) create mode 100644 lib/recorder.js diff --git a/lib/recorder.js b/lib/recorder.js new file mode 100644 index 0000000..0fcb6b3 --- /dev/null +++ b/lib/recorder.js @@ -0,0 +1,357 @@ +(function(f){if(typeof exports==="object"&&typeof module!=="undefined"){module.exports=f()}else if(typeof define==="function"&&define.amd){define([],f)}else{var g;if(typeof window!=="undefined"){g=window}else if(typeof global!=="undefined"){g=global}else if(typeof self!=="undefined"){g=self}else{g=this}g.Recorder = f()}})(function(){var define,module,exports;return (function e(t,n,r){function s(o,u){if(!n[o]){if(!t[o]){var a=typeof require=="function"&&require;if(!u&&a)return a(o,!0);if(i)return i(o,!0);var f=new Error("Cannot find module '"+o+"'");throw f.code="MODULE_NOT_FOUND",f}var l=n[o]={exports:{}};t[o][0].call(l.exports,function(e){var n=t[o][1][e];return s(n?n:e)},l,l.exports,e,t,n,r)}return n[o].exports}var i=typeof require=="function"&&require;for(var o=0;o + diff --git a/ports.js b/ports.js index 63c02da..f3eed69 100644 --- a/ports.js +++ b/ports.js @@ -2,9 +2,13 @@ const app = Elm.Main.init({flags : {width : window.innerWidth, height : window.i if (app.ports.loadSound) app.ports.loadSound.subscribe(createBuffer) if (app.ports.toEngine) app.ports.toEngine.subscribe(engine) +if (app.ports.toggleRecord) app.ports.toggleRecord.subscribe(toggleRecord) const buffers = {} , ro = new ResizeObserver(sendSize) + , nodeToRecord = Tone.context.createGain() + , recorder = new Recorder(nodeToRecord) +Tone.Master.connect(nodeToRecord) ro.observe(document.getElementById('svgResizeObserver')) let playing = {} @@ -35,6 +39,15 @@ function loadErr(err, soundName) { app.ports.soundLoaded.send(soundName + ' got ' + err) } +function toggleRecord(bool) { + if (bool) recorder.record() + else { + recorder.stop() + recorder.exportWAV(bl => app.ports.gotRecord.send(URL.createObjectURL(bl))) + recorder.clear() + } +} + function engine(o) { let model = null switch ( o.action ) { diff --git a/src/Doc.elm b/src/Doc.elm index e558706..69b16c1 100644 --- a/src/Doc.elm +++ b/src/Doc.elm @@ -169,7 +169,7 @@ update msg doc = ( Tool i, M _ ) -> case i of 1 -> - update (MobileMsg <| MEditor.ChangedTool <| MEditor.Play False) doc + update (MobileMsg <| MEditor.ChangedTool <| MEditor.Play False False) doc 2 -> update (MobileMsg <| MEditor.ChangedTool <| MEditor.Harmonize) doc diff --git a/src/Editor/Mobile.elm b/src/Editor/Mobile.elm index cbb0e1b..dda978d 100644 --- a/src/Editor/Mobile.elm +++ b/src/Editor/Mobile.elm @@ -1,4 +1,4 @@ -module Editor.Mobile exposing (..) +port module Editor.Mobile exposing (..) import Coll exposing (Coll, Id) import Color @@ -14,10 +14,12 @@ import Element.Background as Bg import Element.Font as Font import Element.Input as Input import Engine exposing (Engine) +import File.Download as DL import Fraction as Fract exposing (Fraction) import Harmony as Harmo import Html.Attributes import Interact exposing (Interact) +import Json.Decode as D import Json.Encode as E import Link exposing (Link) import Math.Vector2 as Vec exposing (Vec2, vec2) @@ -32,6 +34,12 @@ import TypedSvg.Core as Svg exposing (Svg) import TypedSvg.Types exposing (Length(..), Opacity(..)) +port toggleRecord : Bool -> Cmd msg + + +port gotRecord : (D.Value -> msg) -> Sub msg + + type alias Model = { dragging : Dragging , tool : Tool @@ -56,7 +64,7 @@ defaultAddPos = type Tool = Edit - | Play Bool + | Play Bool Bool -- Playing, Recording | Harmonize @@ -94,7 +102,7 @@ type Dragging init : Maybe Mobeel -> Maybe ( CommonModel, PanSvg.Model ) -> Model init mayMobile mayShared = { dragging = NoDrag - , tool = Play False + , tool = Play False False , mode = CommonMode Normal , link = Nothing , shallow = Nothing @@ -118,6 +126,8 @@ type Msg | ToggleEngine | PlayGear (Id Geer) | StopGear (Id Geer) + | ToggleRecord Bool + | GotRecord (Result D.Error String) -- | CopyGear (Id Geer) | NewGear Vec2 (Content Wheel) @@ -188,13 +198,13 @@ update msg ( model, mobile ) = ToggleEngine -> case model.tool of - Play True -> + Play True r -> { return - | model = { model | tool = Play False, engine = Engine.init } + | model = { model | tool = Play False r, engine = Engine.init } , toEngine = Just Engine.stop } - Play False -> + Play False r -> let ( engine, v ) = Engine.addPlaying @@ -202,11 +212,27 @@ update msg ( model, mobile ) = mobile.gears model.engine in - { return | model = { model | tool = Play True, engine = engine }, toEngine = v } + { return | model = { model | tool = Play True r, engine = engine }, toEngine = v } + + _ -> + return + + ToggleRecord rec -> + case model.tool of + Play on _ -> + { return | model = { model | tool = Play on rec }, cmd = toggleRecord rec } _ -> return + GotRecord res -> + case res of + Ok url -> + { return | cmd = DL.url url } + + Err err -> + Debug.log (D.errorToString err) return + PlayGear id -> let ( engine, v ) = @@ -562,6 +588,7 @@ update msg ( model, mobile ) = subs : Model -> List (Sub Msg) subs { interact } = (Sub.map SvgMsg <| PanSvg.sub) + :: (gotRecord <| (GotRecord << D.decodeValue D.string)) :: (List.map (Sub.map InteractMsg) <| Interact.subs interact) @@ -570,7 +597,7 @@ viewTools model = Input.radioRow [ spacing 30 ] { onChange = ChangedTool , options = - [ Input.option (Play False) <| text "Jeu (W)" + [ Input.option (Play False False) <| text "Jeu (W)" , Input.option Harmonize <| text "Harmonie (X)" , Input.option Edit <| text "Édition (C)" ] @@ -581,9 +608,9 @@ viewTools model = viewExtraTools : Model -> Element Msg viewExtraTools model = - row [ width fill, padding 20 ] + row [ width fill, padding 20, spacing 20 ] (case model.tool of - Play on -> + Play on rec -> [ Input.button [ centerX ] { label = if on then @@ -593,6 +620,23 @@ viewExtraTools model = text "Jouer" , onPress = Just ToggleEngine } + , Input.button + ([ centerX ] + ++ (if rec then + [ Bg.color (rgb 1 0 0) ] + + else + [] + ) + ) + { label = + if rec then + text "Cut" + + else + text "Rec" + , onPress = Just <| ToggleRecord <| not rec + } ] _ -> @@ -669,7 +713,7 @@ viewContent ( model, mobile ) = Coll.get id mobile.gears in case model.tool of - Play _ -> + Play _ _ -> let length = Harmo.getLength g.harmony mobile.gears @@ -687,7 +731,7 @@ viewContent ( model, mobile ) = CompleteLink l -> case model.tool of - Play _ -> + Play _ _ -> Link.viewMotorLink False <| Gear.toDrawLink mobile.gears l Harmonize -> @@ -703,7 +747,7 @@ viewContent ( model, mobile ) = [] ) ++ (case model.tool of - Play _ -> + Play _ _ -> let cuts = case model.dragging of @@ -1098,7 +1142,7 @@ manageInteractEvent event model mobile = _ -> case model.tool of -- PLAY -------- - Play on -> + Play on _ -> interactPlay on event model mobile -- LINK -------- From 38650c2e680abc6d52bb6ad8a800db205931df17 Mon Sep 17 00:00:00 2001 From: cbossut Date: Wed, 22 Jan 2020 19:00:31 +0100 Subject: [PATCH 11/37] minor Prevent play if no motor clean debug log --- src/Editor/Mobile.elm | 38 +++++++++++++++++++++----------------- src/Main.elm | 2 +- 2 files changed, 22 insertions(+), 18 deletions(-) diff --git a/src/Editor/Mobile.elm b/src/Editor/Mobile.elm index dda978d..00b0928 100644 --- a/src/Editor/Mobile.elm +++ b/src/Editor/Mobile.elm @@ -197,25 +197,29 @@ update msg ( model, mobile ) = { return | model = { model | mode = mode } } ToggleEngine -> - case model.tool of - Play True r -> - { return - | model = { model | tool = Play False r, engine = Engine.init } - , toEngine = Just Engine.stop - } + if Coll.maybeGet mobile.motor mobile.gears == Nothing then + return - Play False r -> - let - ( engine, v ) = - Engine.addPlaying - (Motor.getMotored mobile.motor mobile.gears) - mobile.gears - model.engine - in - { return | model = { model | tool = Play True r, engine = engine }, toEngine = v } + else + case model.tool of + Play True r -> + { return + | model = { model | tool = Play False r, engine = Engine.init } + , toEngine = Just Engine.stop + } - _ -> - return + Play False r -> + let + ( engine, v ) = + Engine.addPlaying + (Motor.getMotored mobile.motor mobile.gears) + mobile.gears + model.engine + in + { return | model = { model | tool = Play True r, engine = engine }, toEngine = v } + + _ -> + return ToggleRecord rec -> case model.tool of diff --git a/src/Main.elm b/src/Main.elm index 8977d42..220c3aa 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -566,7 +566,7 @@ viewSounds model = [ Element.html <| Html.audio [ Attr.hidden True - , Attr.src <| Debug.log "url" <| Url.Builder.relative [ "sons", s ] [] + , Attr.src <| Url.Builder.relative [ "sons", s ] [] , Attr.autoplay True , Events.on "ended" <| D.succeed <| PreListening s False ] From d9034ab757a38bb187b6c53e48c12a438435a4f1 Mon Sep 17 00:00:00 2001 From: cbossut Date: Wed, 22 Jan 2020 19:14:55 +0100 Subject: [PATCH 12/37] backspace or suppress to delete --- src/Doc.elm | 17 +++++++++++++++++ src/Main.elm | 2 ++ 2 files changed, 19 insertions(+) diff --git a/src/Doc.elm b/src/Doc.elm index 69b16c1..34f47f0 100644 --- a/src/Doc.elm +++ b/src/Doc.elm @@ -56,6 +56,7 @@ type Shortcut | Play | Left | Right + | Suppr type Msg @@ -203,6 +204,22 @@ update msg doc = ( Right, C _ ) -> update (CollarMsg <| CEditor.CursorRight) doc + ( Suppr, C e ) -> + case e.common.edit of + Just (B i) -> + update (CollarMsg <| CEditor.DeleteBead i) doc + + _ -> + ( doc, Cmd.none ) + + ( Suppr, M e ) -> + case e.common.edit of + Just (G id) -> + update (MobileMsg <| MEditor.DeleteGear id) doc + + _ -> + ( doc, Cmd.none ) + _ -> ( doc, Cmd.none ) diff --git a/src/Main.elm b/src/Main.elm index 220c3aa..57258fc 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -413,6 +413,8 @@ keyCodeToShortcut = , ( "Space", Doc.Play ) , ( "ArrowLeft", Doc.Left ) , ( "ArrowRight", Doc.Right ) + , ( "Backspace", Doc.Suppr ) + , ( "Delete", Doc.Suppr ) ] From fd74521347f0c5f92fe55ea93be71dbc8f7da24e Mon Sep 17 00:00:00 2001 From: cbossut Date: Wed, 22 Jan 2020 19:17:24 +0100 Subject: [PATCH 13/37] minor clean debug log --- src/Editor/Common.elm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Editor/Common.elm b/src/Editor/Common.elm index 3d4abe2..1fb8002 100644 --- a/src/Editor/Common.elm +++ b/src/Editor/Common.elm @@ -141,8 +141,7 @@ commonUpdate msg model = (\id -> Maybe.map2 Tuple.pair (getWheelFromContent id content) - <| - Debug.log "length" (getLengthFromContent (Debug.log "id" id) <| Debug.log "contont" content) + (getLengthFromContent id content) ) } From cf2e06c29f924d6b661e9a764bf1a0ced16dac7e Mon Sep 17 00:00:00 2001 From: cbossut Date: Wed, 22 Jan 2020 21:48:12 +0100 Subject: [PATCH 14/37] Multi selection to Capsule --- src/Data/Wheel.elm | 81 ++++++++++++++++++++++--------------------- src/Doc.elm | 4 +-- src/Editor/Collar.elm | 8 ++--- src/Editor/Common.elm | 30 ++++++++-------- src/Editor/Mobile.elm | 69 ++++++++++++++++++++++++++++++------ 5 files changed, 121 insertions(+), 71 deletions(-) diff --git a/src/Data/Wheel.elm b/src/Data/Wheel.elm index 2301f98..72863e4 100644 --- a/src/Data/Wheel.elm +++ b/src/Data/Wheel.elm @@ -75,7 +75,7 @@ fromContent c = type Mod = None | Selectable - | Selected + | Selected Bool | Resizing @@ -233,48 +233,51 @@ view w pos length style id uid = ) ) ] - ++ (if style.mod == Selected then - [ S.circle - [ SA.cx <| Num 0 - , SA.cy <| Num 0 - , SA.r <| Num (length / 2 + tickW * 2) - , SA.strokeWidth <| Num (tickW / 2) - , SA.stroke Color.black - , SA.fill FillNone + ++ (case style.mod of + Selected first -> + [ S.circle + [ SA.cx <| Num 0 + , SA.cy <| Num 0 + , SA.r <| Num (length / 2 + tickW * 2) + , SA.strokeWidth <| Num (tickW / 2) + , SA.stroke <| + if first then + Color.red + + else + Color.black + , SA.fill FillNone + ] + [] ] - [] - ] - else - [] - ) - ++ (if style.mod == Resizing then - [ S.polyline - [ SA.points [ ( -length / 2, 0 ), ( length / 2, 0 ) ] - , SA.stroke Color.red - , SA.strokeWidth <| Num tickW + Resizing -> + [ S.polyline + [ SA.points [ ( -length / 2, 0 ), ( length / 2, 0 ) ] + , SA.stroke Color.red + , SA.strokeWidth <| Num tickW + ] + [] + , S.circle + ([ SA.cx <| Num (-length / 2) + , SA.cy <| Num 0 + , SA.r <| Num (tickW * 2) + ] + ++ Interact.draggableEvents (IResizeHandle id False) + ) + [] + , S.circle + ([ SA.cx <| Num (length / 2) + , SA.cy <| Num 0 + , SA.r <| Num (tickW * 2) + ] + ++ Interact.draggableEvents (IResizeHandle id True) + ) + [] ] - [] - , S.circle - ([ SA.cx <| Num (-length / 2) - , SA.cy <| Num 0 - , SA.r <| Num (tickW * 2) - ] - ++ Interact.draggableEvents (IResizeHandle id False) - ) - [] - , S.circle - ([ SA.cx <| Num (length / 2) - , SA.cy <| Num 0 - , SA.r <| Num (tickW * 2) - ] - ++ Interact.draggableEvents (IResizeHandle id True) - ) - [] - ] - else - [] + _ -> + [] ) ) diff --git a/src/Doc.elm b/src/Doc.elm index 34f47f0..3bc2cec 100644 --- a/src/Doc.elm +++ b/src/Doc.elm @@ -206,7 +206,7 @@ update msg doc = ( Suppr, C e ) -> case e.common.edit of - Just (B i) -> + [ B i ] -> update (CollarMsg <| CEditor.DeleteBead i) doc _ -> @@ -214,7 +214,7 @@ update msg doc = ( Suppr, M e ) -> case e.common.edit of - Just (G id) -> + [ G id ] -> update (MobileMsg <| MEditor.DeleteGear id) doc _ -> diff --git a/src/Editor/Collar.elm b/src/Editor/Collar.elm index 380cf45..cf00526 100644 --- a/src/Editor/Collar.elm +++ b/src/Editor/Collar.elm @@ -158,7 +158,7 @@ update msg ( model, collar ) = else case model.common.edit of - Just (B i) -> + [ B i ] -> update (WheelMsg ( i, Wheel.ChangeContent <| Wheel.getContent { wheel = w } )) ( model, collar ) _ -> @@ -214,8 +214,8 @@ viewContent ( model, collar ) = let getMod : Int -> Wheel.Mod getMod i = - if model.tool == Edit && model.common.edit == Just (B i) then - Wheel.Selected + if model.tool == Edit && model.common.edit == [ B i ] then + Wheel.Selected False else case Interact.getInteract model.interact of @@ -301,7 +301,7 @@ viewDetails model c = _ -> case ( model.tool, model.common.edit ) of - ( Edit, Just (B i) ) -> + ( Edit, [ B i ] ) -> let b = Collar.get i c diff --git a/src/Editor/Common.elm b/src/Editor/Common.elm index 1fb8002..7d32bf6 100644 --- a/src/Editor/Common.elm +++ b/src/Editor/Common.elm @@ -16,7 +16,7 @@ import Sound exposing (Sound) type alias CommonModel = - { edit : Maybe Identifier + { edit : List Identifier , pack : Maybe ( Wheel, Float ) } @@ -91,7 +91,7 @@ fromWheelInteractable i = commonInit : Maybe CommonModel -> CommonModel commonInit may = - { edit = Nothing + { edit = [] , pack = Maybe.withDefault Nothing <| Maybe.map .pack may } @@ -127,22 +127,19 @@ commonUpdate : CommonMsg -> CommonModel -> CommonModel commonUpdate msg model = case msg of Delete id -> - if model.edit == Just id then - { model | edit = Nothing } - - else - model + { model | edit = List.filter ((/=) id) model.edit } Pack content -> { model | pack = - model.edit - |> Maybe.andThen - (\id -> - Maybe.map2 Tuple.pair - (getWheelFromContent id content) - (getLengthFromContent id content) - ) + case model.edit of + [ id ] -> + Maybe.map2 Tuple.pair + (getWheelFromContent id content) + (getLengthFromContent id content) + + _ -> + Nothing } EmptyPack -> @@ -284,8 +281,11 @@ interactNav event content = interactSelectEdit : Interact.Event Interactable -> CommonModel -> CommonModel interactSelectEdit event model = case ( event.item, event.action ) of + ( IWheel id, Interact.Clicked ( _, False, False ) ) -> + { model | edit = [ id ] } + ( IWheel id, Interact.Clicked _ ) -> - { model | edit = Just id } + { model | edit = id :: model.edit } _ -> model diff --git a/src/Editor/Mobile.elm b/src/Editor/Mobile.elm index 00b0928..61238c4 100644 --- a/src/Editor/Mobile.elm +++ b/src/Editor/Mobile.elm @@ -140,7 +140,7 @@ type Msg | ForcedFract (Link Geer) Fraction | SimplifyFractView | ResizeToContent (Id Geer) - | Capsuled (Id Geer) + | Capsuled (List (Id Geer)) | Collared (Id Geer) | InteractMsg (Interact.Msg Interactable) | SvgMsg PanSvg.Msg @@ -325,7 +325,7 @@ update msg ( model, mobile ) = else case model.common.edit of - Just (G id) -> + [ G id ] -> update (WheelMsg ( id, Wheel.ChangeContent <| Wheel.getContent { wheel = w } )) ( model, mobile ) _ -> @@ -513,20 +513,41 @@ update msg ( model, mobile ) = , toUndo = Do } - Capsuled id -> + Capsuled [] -> + return + + Capsuled (id :: ids) -> let - g = + m = Coll.get id mobile.gears - newG = - { g | motor = Motor.default, harmony = Harmo.newSelf <| Harmo.getLength g.harmony mobile.gears } + newMotor = + { m | motor = Motor.default, harmony = Harmo.newSelf <| Harmo.getLength m.harmony mobile.gears } + + subMobile = + List.foldl + (\i acc -> + let + g = + Coll.get i mobile.gears + + newG = + { g + | motor = Motor.default + , harmony = Harmo.newSelf <| Harmo.getLength g.harmony mobile.gears + } + in + { acc | gears = Coll.insert newG acc.gears } + ) + (Mobile.fromGear newMotor) + ids in { return | mobile = { mobile | gears = Coll.update id - (Wheel.setContent <| Content.M <| Mobile.fromGear newG) + (Wheel.setContent <| Content.M <| subMobile) mobile.gears } , toUndo = Do @@ -657,8 +678,10 @@ viewContent ( model, mobile ) = let getMod : Id Geer -> Wheel.Mod getMod id = - if model.tool == Edit && model.common.edit == Just (G id) then - Wheel.Selected + if model.tool == Edit && List.member (G id) model.common.edit then + Wheel.Selected <| + (List.length model.common.edit > 1) + && ((List.head <| List.reverse model.common.edit) == Just (G id)) else case Interact.getInteract model.interact of @@ -835,7 +858,7 @@ viewDetails model mobile = viewEditDetails : Model -> Mobeel -> List (Element Msg) viewEditDetails model mobile = case model.common.edit of - Just (G id) -> + [ G id ] -> let g = Coll.get id mobile.gears @@ -869,7 +892,7 @@ viewEditDetails model mobile = , viewChangeContent <| ChangedMode <| CommonMode <| ChangeSound <| G id , Input.button [] { label = text "Encapsuler" - , onPress = Just <| Capsuled id + , onPress = Just <| Capsuled [ id ] } , Input.button [] { label = text "Collier" @@ -900,6 +923,30 @@ viewEditDetails model mobile = ] ] + _ :: _ -> + [ viewDetailsColumn <| + (List.map (\id -> text <| getNameFromContent id <| Content.M mobile) <| List.reverse model.common.edit) + ++ [ Input.button [] + { label = text "Encapsuler" + , onPress = + Just <| + Capsuled <| + List.filterMap + (\id -> + case id of + G i -> + Just i + + _ -> + Nothing + ) + <| + List.reverse + model.common.edit + } + ] + ] + _ -> [] From 2e3247afc75fd59077dcb3c41479fa26a32d37f2 Mon Sep 17 00:00:00 2001 From: cbossut Date: Thu, 23 Jan 2020 13:43:33 +0100 Subject: [PATCH 15/37] removed second cursor in wheel view --- src/Data/Wheel.elm | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/src/Data/Wheel.elm b/src/Data/Wheel.elm index 72863e4..1d10bba 100644 --- a/src/Data/Wheel.elm +++ b/src/Data/Wheel.elm @@ -173,20 +173,12 @@ view w pos length style id uid = , SA.fillOpacity <| Opacity (0.2 + 0.8 * w.volume) ] [] - , S.rect - [ SA.width <| Num tickW - , SA.height <| Num tickH - , SA.x <| Num (tickW / -2) - , SA.y <| Num ((length / -2) - tickH) - ] - [] , S.rect [ SA.width <| Num tickW , SA.height <| Num tickH , SA.x <| Num (tickW / -2) , SA.y <| Num (tickH / -2) - , SA.fill <| Fill Color.orange - , SA.transform [ Rotate (w.startPercent * 360) 0 0, Translate 0 ((length / -2) + (tickH / 2)) ] + , SA.transform [ Rotate (w.startPercent * 360) 0 0, Translate 0 ((length / -2) - (tickH / 2)) ] ] [] ] From df346650521933468d308cf013dbb48f48871c8d Mon Sep 17 00:00:00 2001 From: cbossut Date: Thu, 23 Jan 2020 13:48:52 +0100 Subject: [PATCH 16/37] Base color in wheel view --- src/Data/Wheel.elm | 23 ++++++++++++++++++++++- src/Editor/Collar.elm | 4 ++-- src/Editor/Mobile.elm | 8 +++++++- 3 files changed, 31 insertions(+), 4 deletions(-) diff --git a/src/Data/Wheel.elm b/src/Data/Wheel.elm index 1d10bba..31992c0 100644 --- a/src/Data/Wheel.elm +++ b/src/Data/Wheel.elm @@ -80,7 +80,12 @@ type Mod type alias Style = - { mod : Mod, motor : Bool, dashed : Bool } + { mod : Mod, motor : Bool, dashed : Bool, baseColor : Maybe Color } + + +defaultStyle : Style +defaultStyle = + { mod = None, motor = False, dashed = False, baseColor = Nothing } type Interactable x @@ -182,6 +187,22 @@ view w pos length style id uid = ] [] ] + ++ (case style.baseColor of + Just c -> + [ S.circle + [ SA.cx <| Num 0 + , SA.cy <| Num 0 + , SA.r <| Num (length / 2 - tickW * 2.5) + , SA.strokeWidth <| Num (tickW * 4) + , SA.stroke c + , SA.fill FillNone + ] + [] + ] + + Nothing -> + [] + ) ++ (let symSize = length / 4 diff --git a/src/Editor/Collar.elm b/src/Editor/Collar.elm index cf00526..c9191de 100644 --- a/src/Editor/Collar.elm +++ b/src/Editor/Collar.elm @@ -4,7 +4,7 @@ import Color import Data.Collar as Collar exposing (Colleer) import Data.Common as CommonData import Data.Content as Content exposing (Content) -import Data.Wheel as Wheel exposing (Wheel) +import Data.Wheel as Wheel exposing (Wheel, defaultStyle) import Editor.Common exposing (..) import Element exposing (..) import Element.Input as Input @@ -241,7 +241,7 @@ viewContent ( model, collar ) = ( Wheel.view b.wheel (vec2 (p + b.length / 2) <| Vec.getY leftmostPoint) b.length - { mod = getMod i, motor = False, dashed = False } + { defaultStyle | mod = getMod i } (B i) (Collar.toUID i) :: l diff --git a/src/Editor/Mobile.elm b/src/Editor/Mobile.elm index 61238c4..1d4140b 100644 --- a/src/Editor/Mobile.elm +++ b/src/Editor/Mobile.elm @@ -725,7 +725,13 @@ viewContent ( model, mobile ) = Wheel.view g.wheel g.pos (Harmo.getLength g.harmony mobile.gears) - { mod = getMod id, motor = id == mobile.motor, dashed = Harmo.hasHarmonics g.harmony } + { mod = getMod id + , motor = id == mobile.motor + , dashed = Harmo.hasHarmonics g.harmony + , baseColor = + Maybe.map (\bId -> (Coll.get bId mobile.gears).wheel.color) <| + Harmo.getBaseId g.harmony + } (G id) (Gear.toUID id) |> Svg.map (Interact.map fromWheelInteractable) From 517ee0ddcbe2fcb867c0e893aad14bd2edba6ad2 Mon Sep 17 00:00:00 2001 From: cbossut Date: Thu, 23 Jan 2020 14:36:25 +0100 Subject: [PATCH 17/37] Change color when content changed and factorize and fix and group wheelMsgs --- src/Editor/Mobile.elm | 94 +++++++++++++++++++++++++++++++++---------- 1 file changed, 72 insertions(+), 22 deletions(-) diff --git a/src/Editor/Mobile.elm b/src/Editor/Mobile.elm index 1d4140b..958afd2 100644 --- a/src/Editor/Mobile.elm +++ b/src/Editor/Mobile.elm @@ -144,7 +144,7 @@ type Msg | Collared (Id Geer) | InteractMsg (Interact.Msg Interactable) | SvgMsg PanSvg.Msg - | WheelMsg ( Id Geer, Wheel.Msg ) + | WheelMsgs (List ( Id Geer, Wheel.Msg )) | GearMsg ( Id Geer, Gear.Msg ) | OutMsg DocMsg @@ -254,15 +254,12 @@ update msg ( model, mobile ) = let ( id, gears ) = Coll.insertTellId (Mobile.gearFromContent content p) mobile.gears - - colorGen = - Random.map (\f -> Color.hsl f 1 0.5) <| Random.float 0 1 in { return | mobile = { mobile | gears = gears } , toUndo = Group , model = { model | svg = PanSvg.centerZoom (Mobile.gearPosSize id gears) model.svg } - , cmd = Random.generate (\color -> WheelMsg ( id, Wheel.ChangeColor color )) colorGen + , cmd = Random.generate (\color -> WheelMsgs [ ( id, Wheel.ChangeColor color ) ]) colorGen } DeleteGear id -> @@ -326,7 +323,7 @@ update msg ( model, mobile ) = else case model.common.edit of [ G id ] -> - update (WheelMsg ( id, Wheel.ChangeContent <| Wheel.getContent { wheel = w } )) ( model, mobile ) + doChangeContent id (Wheel.getContent { wheel = w }) (Just w.color) model mobile _ -> return @@ -566,8 +563,18 @@ update msg ( model, mobile ) = , toUndo = Do } - WheelMsg ( id, subMsg ) -> - { return | mobile = { mobile | gears = Coll.update id (Wheel.update subMsg) mobile.gears }, toUndo = Do } + WheelMsgs msgs -> + { return + | mobile = + { mobile + | gears = + List.foldl + (\( id, subMsg ) gears -> Coll.update id (Wheel.update subMsg) gears) + mobile.gears + msgs + } + , toUndo = Do + } GearMsg ( id, subMsg ) -> { return | mobile = { mobile | gears = Coll.update id (Gear.update subMsg) mobile.gears }, toUndo = Do } @@ -870,10 +877,10 @@ viewEditDetails model mobile = Coll.get id mobile.gears in [ viewDetailsColumn <| - [ viewNameInput g (Gear.toUID id) <| \str -> WheelMsg ( id, Wheel.Named str ) + [ viewNameInput g (Gear.toUID id) <| \str -> WheelMsgs [ ( id, Wheel.Named str ) ] , viewContentButton g <| OutMsg <| Inside <| G id , column [ width fill, scrollbarY, spacing 20, padding 10 ] <| - [ viewVolumeSlider g <| \f -> WheelMsg ( id, Wheel.ChangeVolume f ) + [ viewVolumeSlider g <| \f -> WheelMsgs [ ( id, Wheel.ChangeVolume f ) ] , row [ spacing 16 ] <| text "x" :: List.map @@ -1116,6 +1123,55 @@ doResize id oldPos newPos add mobile = { mobile | gears = Harmo.resizeFree id newSize gears } +doChangeContent : Id Geer -> Content Wheel -> Maybe Color.Color -> Model -> Mobeel -> Return +doChangeContent id c mayColor model mobile = + let + return = + { model = model + , mobile = mobile + , toUndo = NOOP + , toEngine = Nothing + , outMsg = Nothing + , cmd = Cmd.none + } + + group = + Harmo.getHarmonicGroup (Coll.idMap id) mobile.gears + + chSound = + Wheel.update <| Wheel.ChangeContent c + + gears = + List.foldl (\el -> Coll.update el chSound) mobile.gears group + + newModel = + { model | mode = CommonMode Normal } + in + case mayColor of + Just color -> + let + chColor = + Wheel.update <| Wheel.ChangeColor color + in + { return + | mobile = { mobile | gears = List.foldl (\el -> Coll.update el chColor) gears group } + , toUndo = Do + , model = newModel + } + + Nothing -> + let + colorToMsgs color = + List.map (\el -> ( el, Wheel.ChangeColor color )) group + in + { return + | mobile = { mobile | gears = gears } + , toUndo = Group + , model = newModel + , cmd = Random.generate (WheelMsgs << colorToMsgs) colorGen + } + + computeCuts : ( Vec2, Vec2 ) -> Coll Geer -> List (Link Geer) computeCuts cut gears = Motor.getAllLinks gears @@ -1162,18 +1218,7 @@ manageInteractEvent event model mobile = CommonMode (ChangeSound (G id)) -> case ( event.item, event.action ) of ( ISound s, Interact.Clicked _ ) -> - let - group = - Harmo.getHarmonicGroup (Coll.idMap id) mobile.gears - - chSound = - Wheel.update <| Wheel.ChangeContent <| Content.S s - in - { return - | mobile = { mobile | gears = List.foldl (\el -> Coll.update el chSound) mobile.gears group } - , toUndo = Do - , model = { model | mode = CommonMode Normal } - } + doChangeContent id (Content.S s) Nothing model mobile _ -> return @@ -1438,3 +1483,8 @@ interactMove event model mobile = _ -> Nothing + + +colorGen : Random.Generator Color.Color +colorGen = + Random.map (\f -> Color.hsl f 1 0.5) <| Random.float 0 1 From 24c34c6c9ae0250d041ab10cb610ba402ce5d073 Mon Sep 17 00:00:00 2001 From: cbossut Date: Thu, 23 Jan 2020 16:22:22 +0100 Subject: [PATCH 18/37] moved shallow to dragging --- src/Editor/Mobile.elm | 51 ++++++++++++++++++------------------------- 1 file changed, 21 insertions(+), 30 deletions(-) diff --git a/src/Editor/Mobile.elm b/src/Editor/Mobile.elm index 958afd2..ad9e935 100644 --- a/src/Editor/Mobile.elm +++ b/src/Editor/Mobile.elm @@ -45,7 +45,6 @@ type alias Model = , tool : Tool , mode : Mode , link : Maybe LinkInfo - , shallow : Maybe ( Vec2, Float ) , engine : Engine , interact : Interact.State Interactable , common : CommonModel @@ -97,6 +96,8 @@ type Dragging | VolumeChange | SizeChange | Moving + | Content ( Vec2, Float ) + | ChgContent (Id Geer) Dragging init : Maybe Mobeel -> Maybe ( CommonModel, PanSvg.Model ) -> Model @@ -105,7 +106,6 @@ init mayMobile mayShared = , tool = Play False False , mode = CommonMode Normal , link = Nothing - , shallow = Nothing , engine = Engine.init , interact = Interact.init , common = commonInit <| Maybe.map Tuple.first mayShared @@ -783,6 +783,19 @@ viewContent ( model, mobile ) = Cut seg _ -> [ Link.drawCut seg <| PanSvg.getScale model.svg ] + Content ( p, l ) -> + [ S.circle + [ SA.cx <| Num <| Vec.getX p + , SA.cy <| Num <| Vec.getY p + , SA.r <| Num (l / 2) + , SA.strokeWidth <| Num <| l / 30 + , SA.stroke Color.black + , SA.strokeOpacity <| Opacity 0.5 + , SA.fillOpacity <| Opacity 0 + ] + [] + ] + _ -> [] ) @@ -821,23 +834,6 @@ viewContent ( model, mobile ) = _ -> [] ) - ++ (case model.shallow of - Just ( p, l ) -> - [ S.circle - [ SA.cx <| Num <| Vec.getX p - , SA.cy <| Num <| Vec.getY p - , SA.r <| Num (l / 2) - , SA.strokeWidth <| Num <| l / 30 - , SA.stroke Color.black - , SA.strokeOpacity <| Opacity 0.5 - , SA.fillOpacity <| Opacity 0 - ] - [] - ] - - Nothing -> - [] - ) viewDetails : Model -> Mobeel -> List (Element Msg) @@ -1224,22 +1220,17 @@ manageInteractEvent event model mobile = return CommonMode Normal -> - case ( event.item, event.action ) of - ( ISound s, Interact.Clicked _ ) -> + case ( event.item, event.action, model.dragging ) of + ( ISound s, Interact.Clicked _, _ ) -> update (NewGear defaultAddPos <| Content.S s) ( model, mobile ) - ( ISound s, Interact.Dragged _ p _ ) -> + ( ISound s, Interact.Dragged _ p _, _ ) -> { return - | model = { model | shallow = Just ( p, Sound.length s ) } + | model = { model | dragging = Content ( p, Sound.length s ) } } - ( ISound s, Interact.DragEnded True ) -> - case model.shallow of - Just ( p, _ ) -> - update (NewGear p <| Content.S s) ( { model | shallow = Nothing }, mobile ) - - Nothing -> - return + ( ISound s, Interact.DragEnded True, Content ( p, _ ) ) -> + update (NewGear p <| Content.S s) ( { model | dragging = NoDrag }, mobile ) _ -> case model.tool of From 589213edca6dab9878591b77a1df4524ccfca258 Mon Sep 17 00:00:00 2001 From: cbossut Date: Thu, 23 Jan 2020 20:06:48 +0100 Subject: [PATCH 19/37] minor --- src/Data/Wheel.elm | 1 + src/Doc.elm | 4 ++-- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Data/Wheel.elm b/src/Data/Wheel.elm index 31992c0..76e2248 100644 --- a/src/Data/Wheel.elm +++ b/src/Data/Wheel.elm @@ -246,6 +246,7 @@ view w pos length style id uid = ) ) ] + -- Not Draggable ++ (case style.mod of Selected first -> [ S.circle diff --git a/src/Doc.elm b/src/Doc.elm index 3bc2cec..e9a8205 100644 --- a/src/Doc.elm +++ b/src/Doc.elm @@ -326,10 +326,10 @@ update msg doc = InteractMsg subMsg -> case doc.editor of M e -> - update (MobileMsg <| MEditor.InteractMsg <| subMsg) doc + update (MobileMsg <| MEditor.InteractMsg subMsg) doc C e -> - update (CollarMsg <| CEditor.InteractMsg <| subMsg) doc + update (CollarMsg <| CEditor.InteractMsg subMsg) doc subs : Doc -> List (Sub Msg) From b360179d297c1e68a7d4345d79c782d24c0ca712 Mon Sep 17 00:00:00 2001 From: cbossut Date: Thu, 23 Jan 2020 20:41:08 +0100 Subject: [PATCH 20/37] fixes (?) to sound motor --- playable.js | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/playable.js b/playable.js index 9ecf767..9de3de1 100644 --- a/playable.js +++ b/playable.js @@ -52,8 +52,8 @@ function prepare(model, rate = 1) { function play(model, t, newModel = {}, volume = 1, mute = false) { // TODO What if no new model (first play) if (!model.paused) return; model.paused = false - model.volume = newModel.volume || 1 // TODO cf first TODO - model.mute = newModel.mute || false // TODO cf first TODO + model.volume = newModel.volume || model.volume // TODO cf first TODO + model.mute = newModel.mute || model.mute // TODO cf first TODO model.startTime = t - model.pauseOffset / model.rate if (model.view) { Tone.Draw.schedule(() => model.view.animate().play(), t) @@ -121,7 +121,7 @@ function stop(model) { function setVolume(model, volume = 1, mute = false) { if (model.soundName) { - if (mute || model.mute) model.player.mute = true + if (mute || model.mute) model.player.volume.value = -100000 else model.player.volume.value = ((model.volume * volume) - 1) * 60 } if (model.mobile) model.gears.map(v => setVolume(v, model.volume * volume, model.mute || mute)) From ebd547ed27c9aded0b9958cf091c2542034da5b7 Mon Sep 17 00:00:00 2001 From: cbossut Date: Thu, 23 Jan 2020 23:07:04 +0100 Subject: [PATCH 21/37] =?UTF-8?q?Move=20doesn=E2=80=99t=20use=20oldPos=20a?= =?UTF-8?q?nymore?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Data/Gear.elm | 6 +++--- src/Editor/Mobile.elm | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Data/Gear.elm b/src/Data/Gear.elm index bdaf29b..f38641d 100644 --- a/src/Data/Gear.elm +++ b/src/Data/Gear.elm @@ -110,15 +110,15 @@ decoder wDecoder = type Msg - = Move Vec2 + = NewPos Vec2 | ResizeFract Fraction update : Msg -> Gear w -> Gear w update msg g = case msg of - Move d -> - { g | pos = Vec.add d g.pos } + NewPos p -> + { g | pos = p } ResizeFract f -> Harmo.setFract (Fract.multiplication (Harmo.getFract g) f) g diff --git a/src/Editor/Mobile.elm b/src/Editor/Mobile.elm index ad9e935..5115391 100644 --- a/src/Editor/Mobile.elm +++ b/src/Editor/Mobile.elm @@ -1458,10 +1458,10 @@ interactHarmonize event model mobile = interactMove : Interact.Event Interactable -> Model -> Mobeel -> Maybe { model : Model, mobile : Mobeel, toUndo : ToUndo } interactMove event model mobile = case ( event.item, event.action, model.dragging ) of - ( IWheel (G id), Interact.Dragged oldPos newPos _, _ ) -> + ( IWheel (G id), Interact.Dragged _ pos _, _ ) -> let gearUp = - Gear.update <| Gear.Move <| Vec.sub newPos oldPos + Gear.update <| Gear.NewPos pos in Just { model = { model | dragging = Moving } From 83cd56260a9aa693cebbc0e332058ee2d5698f62 Mon Sep 17 00:00:00 2001 From: cbossut Date: Thu, 23 Jan 2020 23:12:44 +0100 Subject: [PATCH 22/37] Interact has zones --- src/Data/Wheel.elm | 2 +- src/Doc.elm | 2 +- src/Editor/Collar.elm | 6 +++--- src/Editor/Common.elm | 9 +++++++-- src/Editor/Mobile.elm | 39 ++++++++++++++++++++------------------- src/Interact.elm | 36 ++++++++++++++++++------------------ 6 files changed, 50 insertions(+), 44 deletions(-) diff --git a/src/Data/Wheel.elm b/src/Data/Wheel.elm index 76e2248..b2dd052 100644 --- a/src/Data/Wheel.elm +++ b/src/Data/Wheel.elm @@ -124,7 +124,7 @@ update msg g = { g | wheel = { wheel | color = c } } -view : Wheel -> Vec2 -> Float -> Style -> id -> String -> Svg (Interact.Msg (Interactable id)) +view : Wheel -> Vec2 -> Float -> Style -> id -> String -> Svg (Interact.Msg (Interactable id) zone) view w pos length style id uid = let tickH = diff --git a/src/Doc.elm b/src/Doc.elm index e9a8205..50dd510 100644 --- a/src/Doc.elm +++ b/src/Doc.elm @@ -74,7 +74,7 @@ type Msg | DirectionRepeat PanSvg.Direction | MobileMsg MEditor.Msg | CollarMsg CEditor.Msg - | InteractMsg (Interact.Msg Editors.Interactable) + | InteractMsg (Interact.Msg Editors.Interactable Editors.Zone) update : Msg -> Doc -> ( Doc, Cmd Msg ) diff --git a/src/Editor/Collar.elm b/src/Editor/Collar.elm index c9191de..7bf1f9f 100644 --- a/src/Editor/Collar.elm +++ b/src/Editor/Collar.elm @@ -76,7 +76,7 @@ type Msg | WheelMsg ( Int, Wheel.Msg ) | SvgMsg PanSvg.Msg | OutMsg DocMsg - | InteractMsg (Interact.Msg Interactable) + | InteractMsg (Interact.Msg Interactable Zone) type alias Return = @@ -232,7 +232,7 @@ viewContent ( model, collar ) = Element.html <| S.svg (List.map (Html.Attributes.map SvgMsg) (PanSvg.svgAttributes model.svg) - ++ (List.map (Html.Attributes.map InteractMsg) <| Interact.dragSpaceEvents model.interact) + ++ (List.map (Html.Attributes.map InteractMsg) <| Interact.dragSpaceEvents model.interact ZSurface) ) <| List.map (Svg.map <| InteractMsg << Interact.map fromWheelInteractable) @@ -321,7 +321,7 @@ viewDetails model c = [] -manageInteractEvent : Interact.Event Interactable -> Model -> Colleer -> Return +manageInteractEvent : Interact.Event Interactable Zone -> Model -> Colleer -> Return manageInteractEvent event model collar = let return = diff --git a/src/Editor/Common.elm b/src/Editor/Common.elm index 7d32bf6..700103f 100644 --- a/src/Editor/Common.elm +++ b/src/Editor/Common.elm @@ -79,6 +79,11 @@ type Interactable | ISound Sound +type Zone + = ZSurface + | ZPack + + fromWheelInteractable : Wheel.Interactable Identifier -> Interactable fromWheelInteractable i = case i of @@ -260,7 +265,7 @@ viewPack model packMsg unpackMsg = ) -interactNav : Interact.Event Interactable -> Content Wheel -> Maybe DocMsg +interactNav : Interact.Event Interactable Zone -> Content Wheel -> Maybe DocMsg interactNav event content = case ( event.item, event.action ) of ( IWheel id, Interact.Clicked _ ) -> @@ -278,7 +283,7 @@ interactNav event content = Nothing -interactSelectEdit : Interact.Event Interactable -> CommonModel -> CommonModel +interactSelectEdit : Interact.Event Interactable Zone -> CommonModel -> CommonModel interactSelectEdit event model = case ( event.item, event.action ) of ( IWheel id, Interact.Clicked ( _, False, False ) ) -> diff --git a/src/Editor/Mobile.elm b/src/Editor/Mobile.elm index 5115391..c6d9c18 100644 --- a/src/Editor/Mobile.elm +++ b/src/Editor/Mobile.elm @@ -142,7 +142,7 @@ type Msg | ResizeToContent (Id Geer) | Capsuled (List (Id Geer)) | Collared (Id Geer) - | InteractMsg (Interact.Msg Interactable) + | InteractMsg (Interact.Msg Interactable Zone) | SvgMsg PanSvg.Msg | WheelMsgs (List ( Id Geer, Wheel.Msg )) | GearMsg ( Id Geer, Gear.Msg ) @@ -602,13 +602,14 @@ update msg ( model, mobile ) = let inEvent = case e.action of - Interact.Dragged pos1 pos2 k -> + Interact.Dragged pos1 pos2 k zone -> { e | action = Interact.Dragged (PanSvg.mapIn pos1 newModel.svg) (PanSvg.mapIn pos2 newModel.svg) k + zone } _ -> @@ -721,7 +722,7 @@ viewContent ( model, mobile ) = S.svg (List.map (Html.Attributes.map SvgMsg) (PanSvg.svgAttributes model.svg) ++ (List.map (Html.Attributes.map InteractMsg) <| - Interact.dragSpaceEvents model.interact + Interact.dragSpaceEvents model.interact ZSurface ++ Interact.draggableEvents ISurface ) ) @@ -1174,7 +1175,7 @@ computeCuts cut gears = |> List.filter (Link.cuts cut << Link.toSegment << Gear.toDrawLink gears) -manageInteractEvent : Interact.Event Interactable -> Model -> Mobeel -> Return +manageInteractEvent : Interact.Event Interactable Zone -> Model -> Mobeel -> Return manageInteractEvent event model mobile = let return = @@ -1224,7 +1225,7 @@ manageInteractEvent event model mobile = ( ISound s, Interact.Clicked _, _ ) -> update (NewGear defaultAddPos <| Content.S s) ( model, mobile ) - ( ISound s, Interact.Dragged _ p _, _ ) -> + ( ISound s, Interact.Dragged _ p _ ZSurface, _ ) -> { return | model = { model | dragging = Content ( p, Sound.length s ) } } @@ -1255,7 +1256,7 @@ manageInteractEvent event model mobile = return -interactPlay : Bool -> Interact.Event Interactable -> Model -> Mobeel -> Return +interactPlay : Bool -> Interact.Event Interactable Zone -> Model -> Mobeel -> Return interactPlay on event model mobile = let return = @@ -1293,10 +1294,10 @@ interactPlay on event model mobile = } -- CUT - ( ISurface, Interact.Dragged p1 p2 _, NoDrag ) -> + ( ISurface, Interact.Dragged p1 p2 _ ZSurface, NoDrag ) -> { return | model = { model | dragging = Cut ( p1, p2 ) <| computeCuts ( p1, p2 ) mobile.gears } } - ( ISurface, Interact.Dragged _ p2 _, Cut ( p1, _ ) _ ) -> + ( ISurface, Interact.Dragged _ p2 _ ZSurface, Cut ( p1, _ ) _ ) -> { return | model = { model | dragging = Cut ( p1, p2 ) <| computeCuts ( p1, p2 ) mobile.gears } } ( ISurface, Interact.DragEnded True, Cut _ cuts ) -> @@ -1315,7 +1316,7 @@ interactPlay on event model mobile = } -- VOLUME - ( IWheel (G id), Interact.Dragged oldPos newPos ( True, _, _ ), NoDrag ) -> + ( IWheel (G id), Interact.Dragged oldPos newPos ( True, _, _ ) ZSurface, NoDrag ) -> let res = doVolumeChange id oldPos newPos scale mobile model.engine @@ -1327,7 +1328,7 @@ interactPlay on event model mobile = , toEngine = res.toEngine } - ( IWheel (G id), Interact.Dragged oldPos newPos _, VolumeChange ) -> + ( IWheel (G id), Interact.Dragged oldPos newPos _ ZSurface, VolumeChange ) -> let res = doVolumeChange id oldPos newPos scale mobile model.engine @@ -1338,11 +1339,11 @@ interactPlay on event model mobile = { return | model = { model | dragging = NoDrag }, toUndo = Do } -- LINK -> MOTOR - ( IWheel _, Interact.Dragged _ _ _, CompleteLink _ ) -> + ( IWheel _, Interact.Dragged _ _ _ ZSurface, CompleteLink _ ) -> -- If ConpleteLink, don’t move return - ( IWheel (G id), Interact.Dragged _ pos _, _ ) -> + ( IWheel (G id), Interact.Dragged _ pos _ ZSurface, _ ) -> { return | model = { model | dragging = HalfLink ( id, pos ) } } ( IWheel (G to), Interact.DragIn, HalfLink ( from, _ ) ) -> @@ -1378,7 +1379,7 @@ interactPlay on event model mobile = return -interactHarmonize : Interact.Event Interactable -> Model -> Mobeel -> Return +interactHarmonize : Interact.Event Interactable Zone -> Model -> Mobeel -> Return interactHarmonize event model mobile = let return = @@ -1396,25 +1397,25 @@ interactHarmonize event model mobile = { return | mobile = { mobile | gears = Gear.copy id mobile.gears }, toUndo = Do } -- RESIZE - ( IResizeHandle (G id) add, Interact.Dragged oldPos newPos _, NoDrag ) -> + ( IResizeHandle (G id) add, Interact.Dragged oldPos newPos _ ZSurface, NoDrag ) -> { return | model = { model | dragging = SizeChange } , mobile = doResize id oldPos newPos add mobile , toUndo = Group } - ( IResizeHandle (G id) add, Interact.Dragged oldPos newPos _, SizeChange ) -> + ( IResizeHandle (G id) add, Interact.Dragged oldPos newPos _ ZSurface, SizeChange ) -> { return | mobile = doResize id oldPos newPos add mobile, toUndo = Group } ( _, Interact.DragEnded _, SizeChange ) -> { return | model = { model | dragging = NoDrag }, toUndo = Do } -- LINK -> HARMO - ( IWheel _, Interact.Dragged _ _ _, CompleteLink _ ) -> + ( IWheel _, Interact.Dragged _ _ _ ZSurface, CompleteLink _ ) -> -- If Complete Link, don’t move return - ( IWheel (G id), Interact.Dragged _ pos _, _ ) -> + ( IWheel (G id), Interact.Dragged _ pos _ ZSurface, _ ) -> { return | model = { model | dragging = HalfLink ( id, pos ) } } ( IWheel (G to), Interact.DragIn, HalfLink ( from, _ ) ) -> @@ -1455,10 +1456,10 @@ interactHarmonize event model mobile = return -interactMove : Interact.Event Interactable -> Model -> Mobeel -> Maybe { model : Model, mobile : Mobeel, toUndo : ToUndo } +interactMove : Interact.Event Interactable Zone -> Model -> Mobeel -> Maybe { model : Model, mobile : Mobeel, toUndo : ToUndo } interactMove event model mobile = case ( event.item, event.action, model.dragging ) of - ( IWheel (G id), Interact.Dragged _ pos _, _ ) -> + ( IWheel (G id), Interact.Dragged _ pos _ ZSurface, _ ) -> let gearUp = Gear.update <| Gear.NewPos pos diff --git a/src/Interact.elm b/src/Interact.elm index 6cf3e55..182a975 100644 --- a/src/Interact.elm +++ b/src/Interact.elm @@ -57,17 +57,17 @@ init = } -type Msg item +type Msg item zone = HoverIn item | HoverOut | StartClick item Vec2 Mouse.Keys - | ClickMove Vec2 + | ClickMove zone Vec2 | EndClick | AbortClick | NOOP -map : (a -> b) -> Msg a -> Msg b +map : (a -> b) -> Msg a c -> Msg b c map f m = case m of HoverIn a -> @@ -79,8 +79,8 @@ map f m = HoverOut -> HoverOut - ClickMove v -> - ClickMove v + ClickMove z v -> + ClickMove z v EndClick -> EndClick @@ -92,21 +92,21 @@ map f m = NOOP -type alias Event item = - { action : Action +type alias Event item zone = + { action : Action zone , item : item } -type Action +type Action zone = Clicked ( Bool, Bool, Bool ) - | Dragged Vec2 Vec2 ( Bool, Bool, Bool ) -- oldPos newPos + | Dragged Vec2 Vec2 ( Bool, Bool, Bool ) zone -- oldPos newPos | DragIn | DragOut | DragEnded Bool -- True for Up, False for Abort -update : Msg item -> State item -> ( State item, Maybe (Event item) ) +update : Msg item zone -> State item -> ( State item, Maybe (Event item zone) ) update msg (S state) = case msg of HoverIn id -> @@ -127,11 +127,11 @@ update msg (S state) = StartClick id pos keys -> ( S { state | click = Just <| ClickState id pos False keys }, Nothing ) - ClickMove pos -> + ClickMove zone pos -> case state.click of Just click -> ( S { state | click = Just { click | pos = pos, moved = True } } - , Just <| Event (Dragged click.pos pos <| tupleFromKeys click.keys) click.item + , Just <| Event (Dragged click.pos pos (tupleFromKeys click.keys) zone) click.item ) _ -> @@ -169,7 +169,7 @@ update msg (S state) = ( S state, Nothing ) -subs : State item -> List (Sub (Msg item)) +subs : State item -> List (Sub (Msg item zone)) subs (S { click }) = case click of Nothing -> @@ -190,24 +190,24 @@ subs (S { click }) = ] -dragSpaceEvents : State item -> List (Html.Attribute (Msg item)) -dragSpaceEvents (S { click }) = +dragSpaceEvents : State item -> zone -> List (Html.Attribute (Msg item zone)) +dragSpaceEvents (S { click }) zone = case click of Nothing -> [] Just _ -> - [ Mouse.onMove <| ClickMove << vecFromTuple << .offsetPos ] + [ Mouse.onMove <| ClickMove zone << vecFromTuple << .offsetPos ] -hoverEvents : item -> List (Html.Attribute (Msg item)) +hoverEvents : item -> List (Html.Attribute (Msg item zone)) hoverEvents id = [ Mouse.onEnter <| always <| HoverIn id , Mouse.onLeave <| always HoverOut ] -draggableEvents : item -> List (Html.Attribute (Msg item)) +draggableEvents : item -> List (Html.Attribute (Msg item zone)) draggableEvents id = [ Mouse.onWithOptions "mousedown" { stopPropagation = True, preventDefault = False } <| \e -> StartClick id (vecFromTuple e.offsetPos) e.keys From c6f1b86410312b4147de73ee850dc4d09d149377 Mon Sep 17 00:00:00 2001 From: cbossut Date: Thu, 23 Jan 2020 23:18:00 +0100 Subject: [PATCH 23/37] Preparing for multiple PanSvgs --- src/Editor/Collar.elm | 17 ++++++++++++++++- src/Editor/Common.elm | 5 +++++ src/Editor/Mobile.elm | 18 ++++++++++++++++-- src/PanSvg.elm | 24 ++++++++---------------- 4 files changed, 45 insertions(+), 19 deletions(-) diff --git a/src/Editor/Collar.elm b/src/Editor/Collar.elm index 7bf1f9f..a5bbbe8 100644 --- a/src/Editor/Collar.elm +++ b/src/Editor/Collar.elm @@ -11,6 +11,7 @@ import Element.Input as Input import Engine import Html.Attributes import Interact +import Json.Decode as D import Json.Encode as E import Math.Vector2 as Vec exposing (vec2) import PanSvg @@ -75,6 +76,7 @@ type Msg | ResizeToContent Int | WheelMsg ( Int, Wheel.Msg ) | SvgMsg PanSvg.Msg + | SVGSize (Result D.Error PanSvg.Size) | OutMsg DocMsg | InteractMsg (Interact.Msg Interactable Zone) @@ -179,6 +181,19 @@ update msg ( model, collar ) = SvgMsg subMsg -> { return | model = { model | svg = PanSvg.update subMsg model.svg } } + SVGSize res -> + case res of + Result.Err e -> + Debug.log (D.errorToString e) return + + Result.Ok s -> + { return + | model = + { model + | svg = PanSvg.update (PanSvg.ScaleSize 1 s) model.svg + } + } + OutMsg subMsg -> { return | outMsg = Just subMsg } @@ -200,7 +215,7 @@ update msg ( model, collar ) = subs : Model -> List (Sub Msg) subs { interact } = - (Sub.map SvgMsg <| PanSvg.sub) + PanSvg.newSVGSize (SVGSize << D.decodeValue PanSvg.sizeDecoder) :: (List.map (Sub.map InteractMsg) <| Interact.subs interact) diff --git a/src/Editor/Common.elm b/src/Editor/Common.elm index 700103f..296f4ac 100644 --- a/src/Editor/Common.elm +++ b/src/Editor/Common.elm @@ -15,6 +15,11 @@ import Interact import Sound exposing (Sound) +svgId : String +svgId = + "svg" + + type alias CommonModel = { edit : List Identifier , pack : Maybe ( Wheel, Float ) diff --git a/src/Editor/Mobile.elm b/src/Editor/Mobile.elm index c6d9c18..7991247 100644 --- a/src/Editor/Mobile.elm +++ b/src/Editor/Mobile.elm @@ -112,7 +112,7 @@ init mayMobile mayShared = , svg = let base = - Maybe.withDefault PanSvg.init <| Maybe.map Tuple.second mayShared + Maybe.withDefault (PanSvg.init svgId) <| Maybe.map Tuple.second mayShared in Maybe.withDefault base <| Maybe.map (\m -> PanSvg.centerZoom (Mobile.gearPosSize m.motor m.gears) base) mayMobile @@ -144,6 +144,7 @@ type Msg | Collared (Id Geer) | InteractMsg (Interact.Msg Interactable Zone) | SvgMsg PanSvg.Msg + | SVGSize (Result D.Error PanSvg.Size) | WheelMsgs (List ( Id Geer, Wheel.Msg )) | GearMsg ( Id Geer, Gear.Msg ) | OutMsg DocMsg @@ -585,6 +586,19 @@ update msg ( model, mobile ) = SvgMsg subMsg -> { return | model = { model | svg = PanSvg.update subMsg model.svg } } + SVGSize res -> + case res of + Result.Err e -> + Debug.log (D.errorToString e) return + + Result.Ok s -> + { return + | model = + { model + | svg = PanSvg.update (PanSvg.ScaleSize 1 s) model.svg + } + } + -- TODO use some pattern like outMessage package? or elm-state? elm-return? InteractMsg subMsg -> let @@ -620,7 +634,7 @@ update msg ( model, mobile ) = subs : Model -> List (Sub Msg) subs { interact } = - (Sub.map SvgMsg <| PanSvg.sub) + PanSvg.newSVGSize (SVGSize << D.decodeValue PanSvg.sizeDecoder) :: (gotRecord <| (GotRecord << D.decodeValue D.string)) :: (List.map (Sub.map InteractMsg) <| Interact.subs interact) diff --git a/src/PanSvg.elm b/src/PanSvg.elm index 8ec5113..e827a99 100644 --- a/src/PanSvg.elm +++ b/src/PanSvg.elm @@ -15,6 +15,7 @@ port newSVGSize : (D.Value -> msg) -> Sub msg type alias Model = { svgSize : Size , viewPos : ViewPos + , id : String } @@ -63,15 +64,16 @@ centerZoom ( pos, size ) model = { model | viewPos = ViewPos pos <| size * 8 } -init : Model -init = +init : String -> Model +init id = { svgSize = Size 0 0 , viewPos = ViewPos (vec2 0 0) 10 + , id = id } type Msg - = SVGSize (Result D.Error Size) + = ScaleSize Float Size | Zoom Float ( Float, Float ) | Pan Direction @@ -86,13 +88,8 @@ type Direction update : Msg -> Model -> Model update msg model = case msg of - SVGSize res -> - case res of - Result.Err e -> - Debug.log (D.errorToString e) model - - Result.Ok s -> - { model | svgSize = s } + ScaleSize scale size -> + { model | svgSize = { width = size.width * scale, height = size.height * scale } } Zoom f ( x, y ) -> let @@ -145,16 +142,11 @@ update msg model = } -sub : Sub Msg -sub = - newSVGSize (SVGSize << D.decodeValue sizeDecoder) - - svgAttributes : Model -> List (Svg.Attribute Msg) svgAttributes model = [ computeViewBox model , Wheel.onWheel (\e -> Zoom e.deltaY e.mouseEvent.offsetPos) - , Html.Attributes.id "svg" + , Html.Attributes.id model.id , Svg.attribute "width" "100%" , Svg.attribute "height" "100%" , SA.preserveAspectRatio TypedSvg.Types.AlignNone TypedSvg.Types.Meet From 1851e560f9bcead8d3c3ddfd2675b81ed5b9c1ad Mon Sep 17 00:00:00 2001 From: cbossut Date: Fri, 24 Jan 2020 11:29:40 +0100 Subject: [PATCH 24/37] Coll isEmpty --- src/Coll.elm | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/Coll.elm b/src/Coll.elm index 793d059..370b351 100644 --- a/src/Coll.elm +++ b/src/Coll.elm @@ -13,6 +13,7 @@ module Coll exposing , ids , insert , insertTellId + , isEmpty , maybeGet , remove , startId @@ -80,6 +81,11 @@ empty typeString default = C { nextId = startInt, d = Dict.empty, default = default, typeString = typeString } +isEmpty : Coll item -> Bool +isEmpty (C { d }) = + Dict.isEmpty d + + get : Id item -> Coll item -> item get id (C coll) = case maybeGet id (C coll) of From aa2f46e996913d1de38ff5d00155ccb2be49f19b Mon Sep 17 00:00:00 2001 From: cbossut Date: Fri, 24 Jan 2020 11:30:03 +0100 Subject: [PATCH 25/37] Mobile.newSizedGear --- src/Data/Mobile.elm | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/Data/Mobile.elm b/src/Data/Mobile.elm index 8dc5004..1a8fca1 100644 --- a/src/Data/Mobile.elm +++ b/src/Data/Mobile.elm @@ -53,6 +53,11 @@ gearFromContent c pos = } +newSizedGear : Vec2 -> Float -> Wheel -> Geer +newSizedGear p l w = + { pos = p, harmony = Harmo.newSelf l, motor = [], wheel = w } + + gearName : Id Geer -> Coll Geer -> String gearName id coll = let From fc325f4a615855d3a9035a6845fc88305a200555 Mon Sep 17 00:00:00 2001 From: cbossut Date: Fri, 24 Jan 2020 11:31:24 +0100 Subject: [PATCH 26/37] Wheel.drawSimple --- src/Data/Wheel.elm | 77 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 77 insertions(+) diff --git a/src/Data/Wheel.elm b/src/Data/Wheel.elm index b2dd052..c228704 100644 --- a/src/Data/Wheel.elm +++ b/src/Data/Wheel.elm @@ -296,6 +296,83 @@ view w pos length style id uid = ) +drawSimple : Wheel -> Vec2 -> Float -> Svg msg +drawSimple w pos length = + let + tickH = + length / 15 + + tickW = + length / 30 + in + S.g [ SA.transform [ Translate (getX pos) (getY pos) ] ] <| + [ S.circle + [ SA.cx <| Num 0 + , SA.cy <| Num 0 + , SA.r <| Num (length / 2) + , SA.stroke Color.black + , SA.strokeWidth <| Num tickW + , SA.fill <| + if w.mute then + Fill Color.white + + else + Fill w.color + , SA.fillOpacity <| Opacity (0.2 + 0.8 * w.volume) + ] + [] + , S.rect + [ SA.width <| Num tickW + , SA.height <| Num tickH + , SA.x <| Num (tickW / -2) + , SA.y <| Num (tickH / -2) + , SA.transform [ Rotate (w.startPercent * 360) 0 0, Translate 0 ((length / -2) - (tickH / 2)) ] + ] + [] + ] + ++ (let + symSize = + length / 4 + in + case w.content of + C (Content.M _) -> + [ S.line + [ SA.x1 <| Num -symSize + , SA.y1 <| Num -symSize + , SA.x2 <| Num symSize + , SA.y2 <| Num symSize + , SA.stroke Color.grey + , SA.strokeWidth <| Num tickW + ] + [] + , S.line + [ SA.x1 <| Num -symSize + , SA.y1 <| Num symSize + , SA.x2 <| Num symSize + , SA.y2 <| Num -symSize + , SA.stroke Color.grey + , SA.strokeWidth <| Num tickW + ] + [] + ] + + C (Content.C _) -> + [ S.line + [ SA.x1 <| Num -symSize + , SA.y1 <| Num 0 + , SA.x2 <| Num symSize + , SA.y2 <| Num 0 + , SA.stroke Color.grey + , SA.strokeWidth <| Num tickW + ] + [] + ] + + _ -> + [] + ) + + encoder : Wheel -> List ( String, E.Value ) encoder w = [ ( "name", E.string w.name ) From 353e27a4bc00b1d6e5636913ede8086043bee1ae Mon Sep 17 00:00:00 2001 From: cbossut Date: Fri, 24 Jan 2020 11:45:03 +0100 Subject: [PATCH 27/37] Can Cancel Group --- src/Doc.elm | 3 +++ src/Editor/Common.elm | 1 + 2 files changed, 4 insertions(+) diff --git a/src/Doc.elm b/src/Doc.elm index 50dd510..5ee55e2 100644 --- a/src/Doc.elm +++ b/src/Doc.elm @@ -614,5 +614,8 @@ updateData to newMobile { data } = Editors.Group -> Data.group newMobile data + Editors.Cancel -> + Data.cancelGroup data + Editors.NOOP -> data diff --git a/src/Editor/Common.elm b/src/Editor/Common.elm index 296f4ac..2ad8159 100644 --- a/src/Editor/Common.elm +++ b/src/Editor/Common.elm @@ -109,6 +109,7 @@ commonInit may = type ToUndo = Do | Group + | Cancel | NOOP From c80ed62888621122242e481f48380e7c36531732 Mon Sep 17 00:00:00 2001 From: cbossut Date: Fri, 24 Jan 2020 13:58:23 +0100 Subject: [PATCH 28/37] =?UTF-8?q?Ze=20F=C3=A9mousse=20WorkPack?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Doc.elm | 26 ++++++ src/Editor/Collar.elm | 19 +++- src/Editor/Common.elm | 213 ++++++++++++++++++++++++++++++++++-------- src/Editor/Mobile.elm | 175 +++++++++++++++++++++++----------- src/PanSvg.elm | 10 +- 5 files changed, 341 insertions(+), 102 deletions(-) diff --git a/src/Doc.elm b/src/Doc.elm index 5ee55e2..a06ff54 100644 --- a/src/Doc.elm +++ b/src/Doc.elm @@ -74,6 +74,7 @@ type Msg | DirectionRepeat PanSvg.Direction | MobileMsg MEditor.Msg | CollarMsg CEditor.Msg + | EditorsMsg Editors.CommonMsg | InteractMsg (Interact.Msg Editors.Interactable Editors.Zone) @@ -323,6 +324,15 @@ update msg doc = _ -> Debug.log "IMPOSSIBLE CollarMsg while viewing no collar" ( doc, Cmd.none ) + EditorsMsg subMsg -> + case doc.editor of + M e -> + update (MobileMsg <| MEditor.CommonMsg subMsg) doc + + C e -> + -- because no drag in collar + ( doc, Cmd.none ) + InteractMsg subMsg -> case doc.editor of M e -> @@ -357,6 +367,15 @@ keyCodeToMode = view : Doc -> Element Msg view doc = + let + ( common, interact ) = + case doc.editor of + M e -> + ( e.common, e.interact ) + + C e -> + ( e.common, e.interact ) + in row [ height fill, width fill ] <| (column [ width fill, height fill ] ([ viewTop doc @@ -364,6 +383,13 @@ view doc = [ width fill , height fill , Element.htmlAttribute <| Html.Attributes.id "svgResizeObserver" + , Element.inFront <| + Editors.viewPack common + (List.map (Html.Attributes.map InteractMsg) <| + Interact.dragSpaceEvents interact Editors.ZPack + ) + EditorsMsg + InteractMsg ] <| viewContent doc diff --git a/src/Editor/Collar.elm b/src/Editor/Collar.elm index a5bbbe8..03eb674 100644 --- a/src/Editor/Collar.elm +++ b/src/Editor/Collar.elm @@ -1,5 +1,6 @@ module Editor.Collar exposing (..) +import Coll import Color import Data.Collar as Collar exposing (Colleer) import Data.Common as CommonData @@ -71,10 +72,10 @@ type Msg | ToggleEngine | NewBead (Content Wheel) | DeleteBead Int - | PackBead | UnpackBead ( Wheel, Float ) Bool | ResizeToContent Int | WheelMsg ( Int, Wheel.Msg ) + | CommonMsg CommonMsg | SvgMsg PanSvg.Msg | SVGSize (Result D.Error PanSvg.Size) | OutMsg DocMsg @@ -147,9 +148,6 @@ update msg ( model, collar ) = } } - PackBead -> - { return | model = { model | common = commonUpdate (Pack <| Content.C collar) model.common } } - UnpackBead ( w, l ) new -> if new then { return @@ -178,6 +176,9 @@ update msg ( model, collar ) = WheelMsg ( i, subMsg ) -> { return | collar = Collar.updateBead i (Wheel.update subMsg) collar, toUndo = Do } + CommonMsg subMsg -> + { return | model = { model | common = commonUpdate subMsg model.common } } + SvgMsg subMsg -> { return | model = { model | svg = PanSvg.update subMsg model.svg } } @@ -191,6 +192,7 @@ update msg ( model, collar ) = | model = { model | svg = PanSvg.update (PanSvg.ScaleSize 1 s) model.svg + , common = commonUpdate (PackSvgMsg <| PanSvg.ScaleSize model.common.packScale s) model.common } } @@ -329,7 +331,7 @@ viewDetails model c = , viewChangeContent <| ChangedMode <| CommonMode <| ChangeSound <| B i , viewDeleteButton <| DeleteBead i ] - ++ viewPack model.common PackBead UnpackBead + ++ (List.map (Element.map CommonMsg) <| viewPackButtons model.common) ] _ -> @@ -366,6 +368,13 @@ manageInteractEvent event model collar = ( ISound s, Interact.Clicked _ ) -> update (NewBead <| Content.S s) ( model, collar ) + ( IWheel (P id), Interact.Clicked _ ) -> + let + p = + Coll.get id model.common.pack + in + update (UnpackBead ( p.wheel, p.length ) True) ( model, collar ) + _ -> case model.tool of Play on -> diff --git a/src/Editor/Common.elm b/src/Editor/Common.elm index 2ad8159..c303a30 100644 --- a/src/Editor/Common.elm +++ b/src/Editor/Common.elm @@ -1,6 +1,7 @@ module Editor.Common exposing (..) -import Coll exposing (Id) +import Coll exposing (Coll, Id) +import Color import Data.Collar as Collar import Data.Content as Content exposing (Content) import Data.Gear as Gear @@ -8,11 +9,18 @@ import Data.Mobile exposing (Geer) import Data.Wheel as Wheel exposing (Wheel, Wheeled) import Element exposing (..) import Element.Background as Bg +import Element.Border as Border import Element.Font as Font import Element.Input as Input import Harmony as Harmo +import Html +import Html.Attributes import Interact +import Math.Vector2 exposing (Vec2, vec2) +import PanSvg import Sound exposing (Sound) +import Svg +import TypedSvg as S svgId : String @@ -20,15 +28,50 @@ svgId = "svg" +packId : String +packId = + "packSvg" + + type alias CommonModel = { edit : List Identifier - , pack : Maybe ( Wheel, Float ) + , pack : Coll Packed + , packVisible : Bool + , packSvg : PanSvg.Model + , packScale : Float + , dragging : Maybe Packed + , initPos : Maybe Vec2 -- TODO could be in Dragging type + } + + +typeString : String +typeString = + "packed" + + +toUID : Id Packed -> String +toUID id = + typeString ++ "-" ++ Coll.idToString id + + +type alias Packed = + { wheel : Wheel + , length : Float + , pos : Vec2 + } + + +defaultPacked = + { wheel = Wheel.default + , length = 0 + , pos = vec2 0 0 } type Identifier = G (Id Geer) | B Int + | P (Id Packed) getNameFromContent : Identifier -> Content Wheel -> String @@ -44,6 +87,9 @@ getNameFromContent id c = G i -> Gear.toUID i + P _ -> + "" + else w.name ) @@ -101,9 +147,17 @@ fromWheelInteractable i = commonInit : Maybe CommonModel -> CommonModel commonInit may = - { edit = [] - , pack = Maybe.withDefault Nothing <| Maybe.map .pack may - } + Maybe.withDefault + { edit = [] + , pack = Coll.empty typeString defaultPacked + , packVisible = False + , packSvg = PanSvg.init packId + , packScale = 0.3 + , dragging = Nothing + , initPos = Nothing + } + <| + Maybe.map (\model -> { model | edit = [] }) may type ToUndo @@ -130,8 +184,15 @@ keyCodeToMode = type CommonMsg = Delete Identifier - | Pack (Content Wheel) + | ShowPack Bool + | Pack + | Unpack (Id Packed) | EmptyPack + | DragTo Packed + | DragFrom (Id Packed) Vec2 + | InitDrag (Id Packed) + | PrepareZoom PanSvg.Model + | PackSvgMsg PanSvg.Msg commonUpdate : CommonMsg -> CommonModel -> CommonModel @@ -140,21 +201,58 @@ commonUpdate msg model = Delete id -> { model | edit = List.filter ((/=) id) model.edit } - Pack content -> + ShowPack b -> + { model | packVisible = b } + + Pack -> + let + pack = + case model.dragging of + Just p -> + Coll.insert p model.pack + + Nothing -> + model.pack + in + { model | pack = pack, dragging = Nothing } + + Unpack id -> + { model | pack = Coll.remove id model.pack } + + EmptyPack -> + { model | pack = Coll.empty typeString defaultPacked } + + DragTo p -> + { model | dragging = Just p } + + DragFrom id pos -> { model - | pack = - case model.edit of - [ id ] -> - Maybe.map2 Tuple.pair - (getWheelFromContent id content) - (getLengthFromContent id content) - - _ -> - Nothing + | pack = Coll.update id (\p -> { p | pos = pos }) model.pack + , initPos = Just <| Maybe.withDefault (Coll.get id model.pack).pos model.initPos } - EmptyPack -> - { model | pack = Nothing } + InitDrag id -> + case model.initPos of + Just pos -> + { model + | pack = Coll.update id (\p -> { p | pos = pos }) model.pack + , initPos = Nothing + } + + Nothing -> + model + + PrepareZoom parent -> + if Coll.isEmpty model.pack then + commonUpdate + (PackSvgMsg <| PanSvg.SetSmallestSize <| parent.viewPos.smallestSize / model.packScale / 4) + model + + else + model + + PackSvgMsg subMsg -> + { model | packSvg = PanSvg.update subMsg model.packSvg } viewDetailsColumn : List (Element msg) -> Element msg @@ -248,27 +346,66 @@ viewDeleteButton msg = } -viewPack : CommonModel -> msg -> (( Wheel, Float ) -> Bool -> msg) -> List (Element msg) -viewPack model packMsg unpackMsg = - Input.button [] - { onPress = Just packMsg - , label = text "Copier" +viewPackButtons : CommonModel -> List (Element CommonMsg) +viewPackButtons model = + [ Input.button [] + { label = + text <| + if model.packVisible then + "Fermer le sac" + + else + "Ouvrir le sac" + , onPress = Just <| ShowPack <| not model.packVisible } - :: (case model.pack of - Nothing -> - [] - - Just ( w, l ) -> - [ Input.button [] - { label = text <| "Coller " ++ w.name - , onPress = Just <| unpackMsg ( w, l ) True - } - , Input.button [] - { label = text <| "Coller Contenu " ++ w.name - , onPress = Just <| unpackMsg ( w, l ) False - } - ] - ) + , Input.button [] + { label = text "Vider son sac" + , onPress = Just <| EmptyPack + } + ] + + +viewPack : + CommonModel + -> List (Html.Attribute msg) + -> (CommonMsg -> msg) + -> (Interact.Msg Interactable zone -> msg) + -> Element msg +viewPack model events wrapCommon wrapInteract = + if model.packVisible then + el + ([ Border.color <| rgb 0 0 0 + , Border.width 4 + , Bg.color <| rgb 1 1 1 + , alignBottom + , alignRight + ] + ++ (List.map Element.htmlAttribute <| + (Html.Attributes.style "height" <| (String.fromFloat <| model.packScale * 100) ++ "%") + :: (Html.Attributes.style "width" <| (String.fromFloat <| model.packScale * 100) ++ "%") + :: events + ) + ) + <| + html <| + S.svg (List.map (Html.Attributes.map (wrapCommon << PackSvgMsg)) <| PanSvg.svgAttributes model.packSvg) <| + List.map + (\( id, p ) -> + Svg.map (wrapInteract << Interact.map fromWheelInteractable) <| + Wheel.view p.wheel p.pos p.length Wheel.defaultStyle (P id) <| + toUID id + ) + (Coll.toList model.pack) + ++ (case model.dragging of + Just { pos, length, wheel } -> + [ Wheel.drawSimple wheel pos length ] + + Nothing -> + [] + ) + + else + Element.none interactNav : Interact.Event Interactable Zone -> Content Wheel -> Maybe DocMsg diff --git a/src/Editor/Mobile.elm b/src/Editor/Mobile.elm index 7991247..ca20c0c 100644 --- a/src/Editor/Mobile.elm +++ b/src/Editor/Mobile.elm @@ -96,26 +96,30 @@ type Dragging | VolumeChange | SizeChange | Moving + | Packing + | Packed Vec2 (Id Packed) | Content ( Vec2, Float ) | ChgContent (Id Geer) Dragging init : Maybe Mobeel -> Maybe ( CommonModel, PanSvg.Model ) -> Model init mayMobile mayShared = + let + base = + Maybe.withDefault (PanSvg.init svgId) <| Maybe.map Tuple.second mayShared + + svg = + Maybe.withDefault base <| + Maybe.map (\m -> PanSvg.centerZoom (Mobile.gearPosSize m.motor m.gears) base) mayMobile + in { dragging = NoDrag , tool = Play False False , mode = CommonMode Normal , link = Nothing , engine = Engine.init , interact = Interact.init - , common = commonInit <| Maybe.map Tuple.first mayShared - , svg = - let - base = - Maybe.withDefault (PanSvg.init svgId) <| Maybe.map Tuple.second mayShared - in - Maybe.withDefault base <| - Maybe.map (\m -> PanSvg.centerZoom (Mobile.gearPosSize m.motor m.gears) base) mayMobile + , common = commonUpdate (PrepareZoom svg) <| commonInit <| Maybe.map Tuple.first mayShared + , svg = svg } @@ -132,8 +136,6 @@ type Msg | CopyGear (Id Geer) | NewGear Vec2 (Content Wheel) | DeleteGear (Id Geer) - | PackGear - | UnpackGear ( Wheel, Float ) Bool -- True for new, False for Content | EnteredFract Bool String -- True for Numerator | AppliedFract (Link Geer) Fraction | EnteredTextFract String @@ -147,6 +149,7 @@ type Msg | SVGSize (Result D.Error PanSvg.Size) | WheelMsgs (List ( Id Geer, Wheel.Msg )) | GearMsg ( Id Geer, Gear.Msg ) + | CommonMsg CommonMsg | OutMsg DocMsg @@ -255,11 +258,14 @@ update msg ( model, mobile ) = let ( id, gears ) = Coll.insertTellId (Mobile.gearFromContent content p) mobile.gears + + svg = + PanSvg.centerZoom (Mobile.gearPosSize id gears) model.svg in { return | mobile = { mobile | gears = gears } , toUndo = Group - , model = { model | svg = PanSvg.centerZoom (Mobile.gearPosSize id gears) model.svg } + , model = { model | svg = svg, common = commonUpdate (PrepareZoom svg) model.common } , cmd = Random.generate (\color -> WheelMsgs [ ( id, Wheel.ChangeColor color ) ]) colorGen } @@ -303,32 +309,6 @@ update msg ( model, mobile ) = } } - PackGear -> - { return | model = { model | common = commonUpdate (Pack <| Content.M mobile) model.common } } - - UnpackGear ( w, l ) new -> - if new then - let - newGear = - { pos = defaultAddPos - , motor = [] - , harmony = Harmo.newSelf l - , wheel = w - } - in - { return - | mobile = { mobile | gears = Coll.insert newGear mobile.gears } - , toUndo = Do - } - - else - case model.common.edit of - [ G id ] -> - doChangeContent id (Wheel.getContent { wheel = w }) (Just w.color) model mobile - - _ -> - return - EnteredFract isNumerator str -> Maybe.map2 Tuple.pair model.link (String.toInt str) |> Maybe.map @@ -584,7 +564,11 @@ update msg ( model, mobile ) = { return | outMsg = Just subMsg } SvgMsg subMsg -> - { return | model = { model | svg = PanSvg.update subMsg model.svg } } + let + svg = + PanSvg.update subMsg model.svg + in + { return | model = { model | svg = svg, common = commonUpdate (PrepareZoom svg) model.common } } SVGSize res -> case res of @@ -596,9 +580,13 @@ update msg ( model, mobile ) = | model = { model | svg = PanSvg.update (PanSvg.ScaleSize 1 s) model.svg + , common = commonUpdate (PackSvgMsg <| PanSvg.ScaleSize model.common.packScale s) model.common } } + CommonMsg subMsg -> + { return | model = { model | common = commonUpdate subMsg model.common } } + -- TODO use some pattern like outMessage package? or elm-state? elm-return? InteractMsg subMsg -> let @@ -613,23 +601,37 @@ update msg ( model, mobile ) = { return | model = newModel } Just e -> - let - inEvent = - case e.action of - Interact.Dragged pos1 pos2 k zone -> - { e - | action = - Interact.Dragged - (PanSvg.mapIn pos1 newModel.svg) - (PanSvg.mapIn pos2 newModel.svg) - k - zone - } + case e.action of + Interact.DragEnded False -> + { return | model = { newModel | dragging = NoDrag }, toUndo = Cancel } - _ -> - e - in - manageInteractEvent inEvent newModel mobile + _ -> + let + inEvent = + case e.action of + Interact.Dragged pos1 pos2 k zone -> + let + svg = + case zone of + ZSurface -> + newModel.svg + + ZPack -> + newModel.common.packSvg + in + { e + | action = + Interact.Dragged + (PanSvg.mapIn pos1 svg) + (PanSvg.mapIn pos2 svg) + k + zone + } + + _ -> + e + in + manageInteractEvent inEvent newModel mobile subs : Model -> List (Sub Msg) @@ -811,6 +813,13 @@ viewContent ( model, mobile ) = [] ] + Packed pos id -> + let + p = + Coll.get id model.common.pack + in + [ Wheel.drawSimple p.wheel pos p.length ] + _ -> [] ) @@ -931,7 +940,7 @@ viewEditDetails model mobile = else viewDeleteButton <| DeleteGear id ] - ++ viewPack model.common PackGear UnpackGear + ++ (List.map (Element.map CommonMsg) <| viewPackButtons model.common) ++ [ text <| "Durée : " ++ Harmo.view id @@ -1247,6 +1256,30 @@ manageInteractEvent event model mobile = ( ISound s, Interact.DragEnded True, Content ( p, _ ) ) -> update (NewGear p <| Content.S s) ( { model | dragging = NoDrag }, mobile ) + ( IWheel (P id), Interact.Dragged _ p _ ZPack, _ ) -> + { return + | model = + { model | dragging = NoDrag, common = commonUpdate (DragFrom id p) model.common } + } + + ( IWheel (P id), Interact.Dragged _ p _ ZSurface, _ ) -> + { return + | model = + { model | dragging = Packed p id, common = commonUpdate (InitDrag id) model.common } + } + + ( IWheel (P id), Interact.DragEnded True, Packed pos _ ) -> + let + p = + Coll.get id model.common.pack + in + { return + | model = { model | dragging = NoDrag } + , mobile = + { mobile | gears = Coll.insert (Mobile.newSizedGear pos p.length p.wheel) mobile.gears } + , toUndo = Do + } + _ -> case model.tool of -- PLAY -------- @@ -1470,7 +1503,11 @@ interactHarmonize event model mobile = return -interactMove : Interact.Event Interactable Zone -> Model -> Mobeel -> Maybe { model : Model, mobile : Mobeel, toUndo : ToUndo } +interactMove : + Interact.Event Interactable Zone + -> Model + -> Mobeel + -> Maybe { model : Model, mobile : Mobeel, toUndo : ToUndo } interactMove event model mobile = case ( event.item, event.action, model.dragging ) of ( IWheel (G id), Interact.Dragged _ pos _ ZSurface, _ ) -> @@ -1487,6 +1524,32 @@ interactMove event model mobile = ( _, Interact.DragEnded _, Moving ) -> Just { model = { model | dragging = NoDrag }, mobile = mobile, toUndo = Do } + ( IWheel (G id), Interact.Dragged _ pos _ ZPack, _ ) -> + Just + { mobile = mobile + , toUndo = Cancel + , model = + { model + | dragging = Packing + , common = + commonUpdate + (DragTo + { pos = pos + , length = Harmo.getLengthId id mobile.gears + , wheel = (Coll.get id mobile.gears).wheel + } + ) + model.common + } + } + + ( IWheel (G id), Interact.DragEnded True, Packing ) -> + Just + { mobile = mobile + , toUndo = Cancel + , model = { model | dragging = NoDrag, common = commonUpdate Pack model.common } + } + _ -> Nothing diff --git a/src/PanSvg.elm b/src/PanSvg.elm index e827a99..63513a6 100644 --- a/src/PanSvg.elm +++ b/src/PanSvg.elm @@ -74,7 +74,8 @@ init id = type Msg = ScaleSize Float Size - | Zoom Float ( Float, Float ) + | SetSmallestSize Float + | ZoomPoint Float ( Float, Float ) | Pan Direction @@ -91,7 +92,10 @@ update msg model = ScaleSize scale size -> { model | svgSize = { width = size.width * scale, height = size.height * scale } } - Zoom f ( x, y ) -> + SetSmallestSize f -> + { model | viewPos = ViewPos model.viewPos.c f } + + ZoomPoint f ( x, y ) -> let vp = model.viewPos @@ -145,7 +149,7 @@ update msg model = svgAttributes : Model -> List (Svg.Attribute Msg) svgAttributes model = [ computeViewBox model - , Wheel.onWheel (\e -> Zoom e.deltaY e.mouseEvent.offsetPos) + , Wheel.onWheel (\e -> ZoomPoint e.deltaY e.mouseEvent.offsetPos) , Html.Attributes.id model.id , Svg.attribute "width" "100%" , Svg.attribute "height" "100%" From 08b96982cb4c225a7cd4966a412112f7f9ee9dcc Mon Sep 17 00:00:00 2001 From: cbossut Date: Fri, 24 Jan 2020 13:58:38 +0100 Subject: [PATCH 29/37] minor todo --- src/Interact.elm | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Interact.elm b/src/Interact.elm index 182a975..583baaf 100644 --- a/src/Interact.elm +++ b/src/Interact.elm @@ -7,6 +7,10 @@ import Json.Decode as D import Math.Vector2 exposing (Vec2, vec2) + +-- TODO Remove OldPos from Drag, but keep track on initPos, and make it a record + + type alias Interact item = Maybe ( item, Mode ) From 37d51b914324406e24f4e65ebe91f20710890ecd Mon Sep 17 00:00:00 2001 From: cbossut Date: Fri, 24 Jan 2020 14:26:14 +0100 Subject: [PATCH 30/37] SupprMode --- src/Editor/Collar.elm | 11 +++++++++++ src/Editor/Common.elm | 6 +++++- src/Editor/Mobile.elm | 11 +++++++++++ 3 files changed, 27 insertions(+), 1 deletion(-) diff --git a/src/Editor/Collar.elm b/src/Editor/Collar.elm index 03eb674..0f8a4e7 100644 --- a/src/Editor/Collar.elm +++ b/src/Editor/Collar.elm @@ -363,6 +363,17 @@ manageInteractEvent event model collar = _ -> return + CommonMode SupprMode -> + case ( event.item, event.action ) of + ( IWheel (B id), Interact.Clicked _ ) -> + update (DeleteBead id) ( model, collar ) + + ( IWheel (P id), Interact.Clicked _ ) -> + update (CommonMsg <| Unpack id) ( model, collar ) + + _ -> + return + CommonMode Normal -> case ( event.item, event.action ) of ( ISound s, Interact.Clicked _ ) -> diff --git a/src/Editor/Common.elm b/src/Editor/Common.elm index c303a30..585716c 100644 --- a/src/Editor/Common.elm +++ b/src/Editor/Common.elm @@ -175,11 +175,15 @@ type CommonMode = Normal | Nav | ChangeSound Identifier + | SupprMode keyCodeToMode : List ( String, CommonMode ) keyCodeToMode = - [ ( "KeyV", Nav ) ] + [ ( "KeyV", Nav ) + , ( "Delete", SupprMode ) + , ( "Backspace", SupprMode ) + ] type CommonMsg diff --git a/src/Editor/Mobile.elm b/src/Editor/Mobile.elm index ca20c0c..6007a6f 100644 --- a/src/Editor/Mobile.elm +++ b/src/Editor/Mobile.elm @@ -1243,6 +1243,17 @@ manageInteractEvent event model mobile = _ -> return + CommonMode SupprMode -> + case ( event.item, event.action ) of + ( IWheel (G id), Interact.Clicked _ ) -> + update (DeleteGear id) ( model, mobile ) + + ( IWheel (P id), Interact.Clicked _ ) -> + update (CommonMsg <| Unpack id) ( model, mobile ) + + _ -> + return + CommonMode Normal -> case ( event.item, event.action, model.dragging ) of ( ISound s, Interact.Clicked _, _ ) -> From 8f22b1dbe1c76491394a68afc7644b6444e0d168 Mon Sep 17 00:00:00 2001 From: cbossut Date: Fri, 24 Jan 2020 14:26:27 +0100 Subject: [PATCH 31/37] Motor is no black --- src/Data/Wheel.elm | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/Data/Wheel.elm b/src/Data/Wheel.elm index c228704..2fd1caf 100644 --- a/src/Data/Wheel.elm +++ b/src/Data/Wheel.elm @@ -170,9 +170,6 @@ view w pos length style id uid = if w.mute then Fill Color.white - else if style.motor then - Fill Color.black - else Fill w.color , SA.fillOpacity <| Opacity (0.2 + 0.8 * w.volume) From a9fe0e01dbe5a2116e559b731ea643572ead775b Mon Sep 17 00:00:00 2001 From: cbossut Date: Fri, 24 Jan 2020 14:32:42 +0100 Subject: [PATCH 32/37] T for Pack show --- src/Doc.elm | 86 +++++++++++++++++++++++-------------------- src/Editor/Common.elm | 8 ++-- src/Main.elm | 1 + 3 files changed, 51 insertions(+), 44 deletions(-) diff --git a/src/Doc.elm b/src/Doc.elm index a06ff54..f5a5427 100644 --- a/src/Doc.elm +++ b/src/Doc.elm @@ -57,6 +57,7 @@ type Shortcut | Left | Right | Suppr + | Pack type Msg @@ -167,63 +168,68 @@ update msg doc = update (CollarMsg <| CEditor.NewBead content) doc KeyPressed sh -> - case ( sh, doc.editor ) of - ( Tool i, M _ ) -> - case i of - 1 -> - update (MobileMsg <| MEditor.ChangedTool <| MEditor.Play False False) doc + case sh of + Pack -> + update (EditorsMsg <| Editors.TogglePack) doc - 2 -> - update (MobileMsg <| MEditor.ChangedTool <| MEditor.Harmonize) doc + _ -> + case ( sh, doc.editor ) of + ( Tool i, M _ ) -> + case i of + 1 -> + update (MobileMsg <| MEditor.ChangedTool <| MEditor.Play False False) doc - 3 -> - update (MobileMsg <| MEditor.ChangedTool <| MEditor.Edit) doc + 2 -> + update (MobileMsg <| MEditor.ChangedTool <| MEditor.Harmonize) doc - _ -> - ( doc, Cmd.none ) + 3 -> + update (MobileMsg <| MEditor.ChangedTool <| MEditor.Edit) doc - ( Tool i, C _ ) -> - case i of - 1 -> - update (CollarMsg <| CEditor.ChangedTool <| CEditor.Play False) doc + _ -> + ( doc, Cmd.none ) - 3 -> - update (CollarMsg <| CEditor.ChangedTool <| CEditor.Edit) doc + ( Tool i, C _ ) -> + case i of + 1 -> + update (CollarMsg <| CEditor.ChangedTool <| CEditor.Play False) doc - _ -> - ( doc, Cmd.none ) + 3 -> + update (CollarMsg <| CEditor.ChangedTool <| CEditor.Edit) doc - ( Play, M _ ) -> - update (MobileMsg <| MEditor.ToggleEngine) doc + _ -> + ( doc, Cmd.none ) - ( Play, C _ ) -> - update (CollarMsg <| CEditor.ToggleEngine) doc + ( Play, M _ ) -> + update (MobileMsg <| MEditor.ToggleEngine) doc - ( Left, C _ ) -> - update (CollarMsg <| CEditor.CursorLeft) doc + ( Play, C _ ) -> + update (CollarMsg <| CEditor.ToggleEngine) doc - ( Right, C _ ) -> - update (CollarMsg <| CEditor.CursorRight) doc + ( Left, C _ ) -> + update (CollarMsg <| CEditor.CursorLeft) doc - ( Suppr, C e ) -> - case e.common.edit of - [ B i ] -> - update (CollarMsg <| CEditor.DeleteBead i) doc + ( Right, C _ ) -> + update (CollarMsg <| CEditor.CursorRight) doc - _ -> - ( doc, Cmd.none ) + ( Suppr, C e ) -> + case e.common.edit of + [ B i ] -> + update (CollarMsg <| CEditor.DeleteBead i) doc + + _ -> + ( doc, Cmd.none ) + + ( Suppr, M e ) -> + case e.common.edit of + [ G id ] -> + update (MobileMsg <| MEditor.DeleteGear id) doc - ( Suppr, M e ) -> - case e.common.edit of - [ G id ] -> - update (MobileMsg <| MEditor.DeleteGear id) doc + _ -> + ( doc, Cmd.none ) _ -> ( doc, Cmd.none ) - _ -> - ( doc, Cmd.none ) - DirectionRepeat dir -> case doc.editor of M editor -> diff --git a/src/Editor/Common.elm b/src/Editor/Common.elm index 585716c..d7f394e 100644 --- a/src/Editor/Common.elm +++ b/src/Editor/Common.elm @@ -188,7 +188,7 @@ keyCodeToMode = type CommonMsg = Delete Identifier - | ShowPack Bool + | TogglePack | Pack | Unpack (Id Packed) | EmptyPack @@ -205,8 +205,8 @@ commonUpdate msg model = Delete id -> { model | edit = List.filter ((/=) id) model.edit } - ShowPack b -> - { model | packVisible = b } + TogglePack -> + { model | packVisible = not model.packVisible } Pack -> let @@ -360,7 +360,7 @@ viewPackButtons model = else "Ouvrir le sac" - , onPress = Just <| ShowPack <| not model.packVisible + , onPress = Just TogglePack } , Input.button [] { label = text "Vider son sac" diff --git a/src/Main.elm b/src/Main.elm index 57258fc..d86d835 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -415,6 +415,7 @@ keyCodeToShortcut = , ( "ArrowRight", Doc.Right ) , ( "Backspace", Doc.Suppr ) , ( "Delete", Doc.Suppr ) + , ( "KeyT", Doc.Pack ) ] From 4dd090e355988316bbee6a27679753bf437f7e29 Mon Sep 17 00:00:00 2001 From: cbossut Date: Fri, 24 Jan 2020 15:10:00 +0100 Subject: [PATCH 33/37] packontent alarach --- src/Editor/Collar.elm | 2 +- src/Editor/Common.elm | 37 +++++++++++++++++++++++++++++++++---- src/Editor/Mobile.elm | 11 ++++++++++- 3 files changed, 44 insertions(+), 6 deletions(-) diff --git a/src/Editor/Collar.elm b/src/Editor/Collar.elm index 0f8a4e7..46b1e19 100644 --- a/src/Editor/Collar.elm +++ b/src/Editor/Collar.elm @@ -331,7 +331,7 @@ viewDetails model c = , viewChangeContent <| ChangedMode <| CommonMode <| ChangeSound <| B i , viewDeleteButton <| DeleteBead i ] - ++ (List.map (Element.map CommonMsg) <| viewPackButtons model.common) + ++ viewPackButtons model.common (Content.C c) (\w -> UnpackBead ( w, 0 ) False) CommonMsg ] _ -> diff --git a/src/Editor/Common.elm b/src/Editor/Common.elm index d7f394e..c692dfb 100644 --- a/src/Editor/Common.elm +++ b/src/Editor/Common.elm @@ -35,6 +35,7 @@ packId = type alias CommonModel = { edit : List Identifier + , packontent : Maybe Wheel , pack : Coll Packed , packVisible : Bool , packSvg : PanSvg.Model @@ -149,6 +150,7 @@ commonInit : Maybe CommonModel -> CommonModel commonInit may = Maybe.withDefault { edit = [] + , packontent = Nothing , pack = Coll.empty typeString defaultPacked , packVisible = False , packSvg = PanSvg.init packId @@ -189,6 +191,7 @@ keyCodeToMode = type CommonMsg = Delete Identifier | TogglePack + | Packontent Wheel | Pack | Unpack (Id Packed) | EmptyPack @@ -208,6 +211,9 @@ commonUpdate msg model = TogglePack -> { model | packVisible = not model.packVisible } + Packontent w -> + { model | packontent = Just w } + Pack -> let pack = @@ -350,8 +356,8 @@ viewDeleteButton msg = } -viewPackButtons : CommonModel -> List (Element CommonMsg) -viewPackButtons model = +viewPackButtons : CommonModel -> Content Wheel -> (Wheel -> msg) -> (CommonMsg -> msg) -> List (Element msg) +viewPackButtons model parent chgContent wrap = [ Input.button [] { label = text <| @@ -360,13 +366,36 @@ viewPackButtons model = else "Ouvrir le sac" - , onPress = Just TogglePack + , onPress = Just <| wrap TogglePack } , Input.button [] { label = text "Vider son sac" - , onPress = Just <| EmptyPack + , onPress = Just <| wrap EmptyPack + } + , Input.button [] + { label = text "Copier Contenu" + , onPress = + Maybe.map (wrap << Packontent) <| + Maybe.andThen (\id -> getWheelFromContent id parent) <| + case model.edit of + [ one ] -> + Just one + + _ -> + Nothing } ] + ++ (case model.packontent of + Just w -> + [ Input.button [] + { label = text <| "Coller Contenu" + , onPress = Just <| chgContent w + } + ] + + Nothing -> + [] + ) viewPack : diff --git a/src/Editor/Mobile.elm b/src/Editor/Mobile.elm index 6007a6f..568f206 100644 --- a/src/Editor/Mobile.elm +++ b/src/Editor/Mobile.elm @@ -134,6 +134,7 @@ type Msg | GotRecord (Result D.Error String) -- | CopyGear (Id Geer) + | CopyContent Wheel | NewGear Vec2 (Content Wheel) | DeleteGear (Id Geer) | EnteredFract Bool String -- True for Numerator @@ -254,6 +255,14 @@ update msg ( model, mobile ) = CopyGear id -> { return | mobile = { mobile | gears = Gear.copy id mobile.gears }, toUndo = Do } + CopyContent w -> + case model.common.edit of + [ G id ] -> + doChangeContent id (Wheel.getContent { wheel = w }) (Just w.color) model mobile + + _ -> + return + NewGear p content -> let ( id, gears ) = @@ -940,7 +949,7 @@ viewEditDetails model mobile = else viewDeleteButton <| DeleteGear id ] - ++ (List.map (Element.map CommonMsg) <| viewPackButtons model.common) + ++ viewPackButtons model.common (Content.M mobile) CopyContent CommonMsg ++ [ text <| "Durée : " ++ Harmo.view id From 95d49e9b3a426ee6cfde472eed2d78c9e614e54c Mon Sep 17 00:00:00 2001 From: cbossut Date: Fri, 24 Jan 2020 16:32:22 +0100 Subject: [PATCH 34/37] view Volume slider track --- src/Editor/Common.elm | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/src/Editor/Common.elm b/src/Editor/Common.elm index c692dfb..1f561bf 100644 --- a/src/Editor/Common.elm +++ b/src/Editor/Common.elm @@ -321,7 +321,17 @@ viewContentButton w msg = viewVolumeSlider : Wheeled x -> (Float -> msg) -> Element msg viewVolumeSlider w msgF = - Input.slider [] + Input.slider + [ behindContent <| + el + [ width fill + , height <| px 2 + , centerY + , Bg.color <| rgb 0 0 0 + , Border.rounded 2 + ] + Element.none + ] { label = Input.labelAbove [] <| text "Volume" , onChange = msgF , value = w.wheel.volume From 65852b781dc23b1457024215b22b5a0ddb0077b4 Mon Sep 17 00:00:00 2001 From: cbossut Date: Sun, 26 Jan 2020 15:04:12 +0100 Subject: [PATCH 35/37] Fix suppr shortcut inactive if not in edit mode --- src/Doc.elm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Doc.elm b/src/Doc.elm index f5a5427..72655d9 100644 --- a/src/Doc.elm +++ b/src/Doc.elm @@ -212,16 +212,16 @@ update msg doc = update (CollarMsg <| CEditor.CursorRight) doc ( Suppr, C e ) -> - case e.common.edit of - [ B i ] -> + case ( e.common.edit, e.tool ) of + ( [ B i ], CEditor.Edit ) -> update (CollarMsg <| CEditor.DeleteBead i) doc _ -> ( doc, Cmd.none ) ( Suppr, M e ) -> - case e.common.edit of - [ G id ] -> + case ( e.common.edit, e.tool ) of + ( [ G id ], MEditor.Edit ) -> update (MobileMsg <| MEditor.DeleteGear id) doc _ -> From e790101f39e250d8d89f68f7f5c7b27624e0ea12 Mon Sep 17 00:00:00 2001 From: cbossut Date: Sun, 26 Jan 2020 15:05:53 +0100 Subject: [PATCH 36/37] OKLM pan in collar view --- src/Doc.elm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Doc.elm b/src/Doc.elm index 72655d9..a88b442 100644 --- a/src/Doc.elm +++ b/src/Doc.elm @@ -235,8 +235,8 @@ update msg doc = M editor -> update (MobileMsg <| MEditor.SvgMsg <| PanSvg.Pan dir) doc - _ -> - ( doc, Cmd.none ) + C editor -> + update (CollarMsg <| CEditor.SvgMsg <| PanSvg.Pan dir) doc MobileMsg subMsg -> case ( doc.editor, getViewing doc ) of From 29911ea2f8d6f099345dc00dd880e2751b0fc02f Mon Sep 17 00:00:00 2001 From: cbossut Date: Sun, 26 Jan 2020 15:25:16 +0100 Subject: [PATCH 37/37] Fix zoom making smallestSize negative --- src/PanSvg.elm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/PanSvg.elm b/src/PanSvg.elm index 63513a6..7cd500c 100644 --- a/src/PanSvg.elm +++ b/src/PanSvg.elm @@ -101,7 +101,7 @@ update msg model = model.viewPos factor = - 1 + f / 1000 + clamp 0.01 2 <| 1 + f / 1000 p = Vec.sub (mapIn (vec2 x y) model) vp.c