From ccbd350d0f82bed7f975dfa3e827e46d443e2a33 Mon Sep 17 00:00:00 2001 From: cbossut Date: Sun, 16 Feb 2020 00:38:35 +0100 Subject: [PATCH 01/11] Add recorder lib to package --- pkgConfig.json | 1 + 1 file changed, 1 insertion(+) diff --git a/pkgConfig.json b/pkgConfig.json index 1a83bfd..ebd20ff 100644 --- a/pkgConfig.json +++ b/pkgConfig.json @@ -6,6 +6,7 @@ , "ports.html" , "ports.js" , "elmApp.js" + , "lib/recorder.js" , "lib/svg.js" , "lib/Tone.js" , "LICENSE.md" From 193edfe2cf4fe0734f414030c4c62555f68146be Mon Sep 17 00:00:00 2001 From: cbossut Date: Thu, 27 Feb 2020 14:25:24 +0100 Subject: [PATCH 02/11] Renew drag event and Move Pack --- src/Editor/Interacting.elm | 3 +- src/Editor/Mobile.elm | 126 ++++++++++++++++++++----------------- src/Interact.elm | 110 ++++++++++++++++++++------------ src/Pack.elm | 9 ++- src/PanSvg.elm | 8 +++ 5 files changed, 156 insertions(+), 100 deletions(-) diff --git a/src/Editor/Interacting.elm b/src/Editor/Interacting.elm index 6790a4a..01c8938 100644 --- a/src/Editor/Interacting.elm +++ b/src/Editor/Interacting.elm @@ -9,9 +9,10 @@ import Sound exposing (Sound) type Interactable = ISurface + | IPack | IWheel Identifier | IResizeHandle (Id Geer) Bool -- True = right - | IPack (Id Packed) + | IPacked (Id Packed) | ISound Sound diff --git a/src/Editor/Mobile.elm b/src/Editor/Mobile.elm index 1f4e6a6..bf1c596 100644 --- a/src/Editor/Mobile.elm +++ b/src/Editor/Mobile.elm @@ -60,7 +60,7 @@ type alias Model = , cursor : Int , link : Maybe LinkInfo , engine : Engine - , interact : Interact.State Interactable + , interact : Interact.State Interactable Zone , pack : Pack , wave : ( Waveform, Maybe Sound ) -- TODO Second source of truth with edit? Could be just Bool , svg : PanSvg.Model @@ -778,25 +778,35 @@ update msg ( model, mobile ) = _ -> let + svgFromZone z = + case z of + ZSurface -> + newModel.svg + + ZPack -> + newModel.pack.svg + + toInPos z p = + PanSvg.mapIn p <| svgFromZone z + inEvent = case e.action of - Interact.Dragged pos1 pos2 k zone -> + Interact.Dragged info dragZone k -> let - svg = - case zone of - ZSurface -> - newModel.svg - - ZPack -> - newModel.pack.svg + startZone = + Tuple.second info.init in { e | action = Interact.Dragged - (PanSvg.mapIn pos1 svg) - (PanSvg.mapIn pos2 svg) + { info + | init = Tuple.mapFirst (toInPos <| Tuple.second info.init) info.init + , oldPos = toInPos dragZone info.oldPos + , newPos = toInPos dragZone info.newPos + , startD = Vec.scale (PanSvg.getScale <| svgFromZone <| Tuple.second info.init) info.startD + } + dragZone k - zone } _ -> @@ -953,6 +963,7 @@ viewContent ( model, mobile ) = Interact.dragSpaceEvents model.interact ZPack ) PackMsg + IPacked IPack InteractMsg , Element.inFront <| Waveform.view viewWave (Tuple.first model.wave) wavePercent percentMsg @@ -1493,15 +1504,13 @@ doLinked l gears = doVolumeChange : Identifier -> Vec2 - -> Vec2 - -> Float -> Mobeel -> Engine -> { mobile : Mobeel, toUndo : ToUndo, toEngine : Maybe E.Value } -doVolumeChange id oldPos newPos scale mobile engine = +doVolumeChange id absD mobile engine = let volume = - (CommonData.getWheel id mobile).volume + (Vec.getY oldPos - Vec.getY newPos) / scale / 100 + (CommonData.getWheel id mobile).volume + Vec.getY absD / 100 in { mobile = CommonData.updateWheel id (Wheel.ChangeVolume volume) mobile , toUndo = Group @@ -1509,8 +1518,8 @@ doVolumeChange id oldPos newPos scale mobile engine = } -doResize : Id Geer -> Vec2 -> Vec2 -> Bool -> Mobeel -> Mobeel -doResize id oldPos newPos add mobile = +doResize : Id Geer -> Vec2 -> Bool -> Mobeel -> Mobeel +doResize id d add mobile = let gears = mobile.gears @@ -1518,15 +1527,12 @@ doResize id oldPos newPos add mobile = length = Harmo.getLengthId id gears - d = - Vec.getX newPos - Vec.getX oldPos - dd = if add then - d + Vec.getX d else - -d + -1 * Vec.getX d newSize = abs <| dd * 2 + length @@ -1654,7 +1660,7 @@ manageInteractEvent event model mobile = ( IWheel id, Interact.Clicked _ ) -> update (DeleteWheel id) ( model, mobile ) - ( IPack id, Interact.Clicked _ ) -> + ( IPacked id, Interact.Clicked _ ) -> update (PackMsg <| Pack.Unpack id) ( model, mobile ) _ -> @@ -1680,16 +1686,16 @@ manageInteractEvent event model mobile = _ -> update (NewGear defaultAddPos <| Content.S s) ( model, mobile ) - ( ISound s, Interact.Dragged _ p _ ZSurface, _ ) -> + ( ISound s, Interact.Dragged { newPos } ZSurface _, _ ) -> { return - | model = { model | dragging = Content ( p, Sound.length s ) } + | model = { model | dragging = Content ( newPos, Sound.length s ) } } ( ISound s, Interact.DragEnded True, Content ( p, _ ) ) -> update (NewGear p <| Content.S s) ( { model | dragging = NoDrag }, mobile ) -- FROM PACK - ( IPack pId, Interact.Clicked _, _ ) -> + ( IPacked pId, Interact.Clicked _, _ ) -> case model.edit of [ id ] -> case Wheel.getWheelContent <| CommonData.getWheel ( id, [] ) mobile of @@ -1710,19 +1716,19 @@ manageInteractEvent event model mobile = _ -> return - ( IPack id, Interact.Dragged _ p _ ZPack, _ ) -> + ( IPacked id, Interact.Dragged { newPos } ZPack _, _ ) -> { return | model = - { model | dragging = NoDrag, pack = Pack.update (Pack.DragFrom id p) model.pack } + { model | dragging = NoDrag, pack = Pack.update (Pack.DragFrom id newPos) model.pack } } - ( IPack id, Interact.Dragged _ p _ ZSurface, _ ) -> + ( IPacked id, Interact.Dragged { newPos } ZSurface _, _ ) -> { return | model = - { model | dragging = Packed p id, pack = Pack.update (Pack.InitDrag id) model.pack } + { model | dragging = Packed newPos id, pack = Pack.update (Pack.InitDrag id) model.pack } } - ( IPack id, Interact.DragEnded True, Packed pos _ ) -> + ( IPacked id, Interact.DragEnded True, Packed pos _ ) -> let p = Coll.get id model.pack.wheels @@ -1734,6 +1740,15 @@ manageInteractEvent event model mobile = , toUndo = Do } + -- Pack Surface + ( IPack, Interact.Dragged { startD } _ _, _ ) -> + { return + | model = + { model + | pack = Pack.update (Pack.SvgMsg <| PanSvg.Move startD) model.pack + } + } + _ -> case model.tool of -- PLAY -------- @@ -1769,9 +1784,6 @@ interactPlay on event model mobile = , outMsg = Nothing , cmd = Cmd.none } - - scale = - PanSvg.getScale model.svg in case ( event.item, event.action, model.dragging ) of -- MUTE @@ -1787,11 +1799,11 @@ interactPlay on event model mobile = } -- CUT - ( ISurface, Interact.Dragged p1 p2 _ ZSurface, NoDrag ) -> - { return | model = { model | dragging = Cut ( p1, p2 ) <| computeCuts ( p1, p2 ) mobile.gears } } + ( ISurface, Interact.Dragged { oldPos, newPos } ZSurface _, NoDrag ) -> + { return | model = { model | dragging = Cut ( oldPos, newPos ) <| computeCuts ( oldPos, newPos ) mobile.gears } } - ( ISurface, Interact.Dragged _ p2 _ ZSurface, Cut ( p1, _ ) _ ) -> - { return | model = { model | dragging = Cut ( p1, p2 ) <| computeCuts ( p1, p2 ) mobile.gears } } + ( ISurface, Interact.Dragged { newPos } ZSurface _, Cut ( p1, _ ) _ ) -> + { return | model = { model | dragging = Cut ( p1, newPos ) <| computeCuts ( p1, newPos ) mobile.gears } } ( ISurface, Interact.DragEnded True, Cut _ cuts ) -> let @@ -1809,10 +1821,10 @@ interactPlay on event model mobile = } -- VOLUME - ( IWheel id, Interact.Dragged oldPos newPos ( True, _, _ ) ZSurface, NoDrag ) -> + ( IWheel id, Interact.Dragged { absD } _ ( True, _, _ ), NoDrag ) -> let res = - doVolumeChange id oldPos newPos scale mobile model.engine + doVolumeChange id absD mobile model.engine in { return | model = { model | dragging = VolumeChange } @@ -1821,10 +1833,10 @@ interactPlay on event model mobile = , toEngine = res.toEngine } - ( IWheel id, Interact.Dragged oldPos newPos _ ZSurface, VolumeChange ) -> + ( IWheel id, Interact.Dragged { absD } _ _, VolumeChange ) -> let res = - doVolumeChange id oldPos newPos scale mobile model.engine + doVolumeChange id absD mobile model.engine in { return | mobile = res.mobile, toUndo = res.toUndo, toEngine = res.toEngine } @@ -1832,12 +1844,12 @@ interactPlay on event model mobile = { return | model = { model | dragging = NoDrag }, toUndo = Do } -- LINK -> MOTOR - ( IWheel ( _, [] ), Interact.Dragged _ _ _ ZSurface, CompleteLink _ ) -> + ( IWheel ( _, [] ), Interact.Dragged _ ZSurface _, CompleteLink _ ) -> -- If ConpleteLink, don’t move return - ( IWheel ( id, [] ), Interact.Dragged _ pos _ ZSurface, _ ) -> - { return | model = { model | dragging = HalfLink ( id, pos ) } } + ( IWheel ( id, [] ), Interact.Dragged { newPos } ZSurface _, _ ) -> + { return | model = { model | dragging = HalfLink ( id, newPos ) } } ( IWheel ( to, [] ), Interact.DragIn, HalfLink ( from, _ ) ) -> { return | model = { model | dragging = CompleteLink ( from, to ) } } @@ -1890,26 +1902,26 @@ interactHarmonize event model mobile = { return | mobile = { mobile | gears = Gear.copy id mobile.gears }, toUndo = Do } -- RESIZE - ( IResizeHandle id add, Interact.Dragged oldPos newPos _ ZSurface, NoDrag ) -> + ( IResizeHandle id add, Interact.Dragged { startD } _ _, NoDrag ) -> { return | model = { model | dragging = SizeChange } - , mobile = doResize id oldPos newPos add mobile + , mobile = doResize id startD add mobile , toUndo = Group } - ( IResizeHandle id add, Interact.Dragged oldPos newPos _ ZSurface, SizeChange ) -> - { return | mobile = doResize id oldPos newPos add mobile, toUndo = Group } + ( IResizeHandle id add, Interact.Dragged { startD } _ _, SizeChange ) -> + { return | mobile = doResize id startD add mobile, toUndo = Group } ( _, Interact.DragEnded _, SizeChange ) -> { return | model = { model | dragging = NoDrag }, toUndo = Do } -- LINK -> HARMO - ( IWheel ( _, [] ), Interact.Dragged _ _ _ ZSurface, CompleteLink _ ) -> + ( IWheel ( _, [] ), Interact.Dragged _ ZSurface _, CompleteLink _ ) -> -- If Complete Link, don’t move return - ( IWheel ( id, [] ), Interact.Dragged _ pos _ ZSurface, _ ) -> - { return | model = { model | dragging = HalfLink ( id, pos ) } } + ( IWheel ( id, [] ), Interact.Dragged { newPos } ZSurface _, _ ) -> + { return | model = { model | dragging = HalfLink ( id, newPos ) } } ( IWheel ( to, [] ), Interact.DragIn, HalfLink ( from, _ ) ) -> { return | model = { model | dragging = CompleteLink ( from, to ) } } @@ -1978,10 +1990,10 @@ interactMove : -> Maybe { model : Model, mobile : Mobeel, toUndo : ToUndo } interactMove event model mobile = case ( event.item, event.action, model.dragging ) of - ( IWheel ( id, [] ), Interact.Dragged _ pos _ ZSurface, _ ) -> + ( IWheel ( id, [] ), Interact.Dragged { newPos } ZSurface _, _ ) -> let gearUp = - Gear.update <| Gear.NewPos pos + Gear.update <| Gear.NewPos newPos in Just { model = { model | dragging = Moving, pack = Pack.update (Pack.DragTo Nothing) model.pack } @@ -1992,7 +2004,7 @@ interactMove event model mobile = ( _, Interact.DragEnded _, Moving ) -> Just { model = { model | dragging = NoDrag }, mobile = mobile, toUndo = Do } - ( IWheel ( id, [] ), Interact.Dragged _ pos _ ZPack, _ ) -> + ( IWheel ( id, [] ), Interact.Dragged { newPos } ZPack _, _ ) -> Just { mobile = mobile , toUndo = Cancel @@ -2003,7 +2015,7 @@ interactMove event model mobile = Pack.update (Pack.DragTo <| Just - { pos = pos + { pos = newPos , length = Harmo.getLengthId id mobile.gears , wheel = (Coll.get id mobile.gears).wheel } diff --git a/src/Interact.elm b/src/Interact.elm index 583baaf..bd39aad 100644 --- a/src/Interact.elm +++ b/src/Interact.elm @@ -4,11 +4,7 @@ import Browser.Events as BE import Html import Html.Events.Extra.Mouse as Mouse 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 +import Math.Vector2 as Vec exposing (Vec2, vec2) type alias Interact item = @@ -21,39 +17,41 @@ type Mode | Drag -getInteract : State item -> Interact item +getInteract : State item zone -> Interact item getInteract (S state) = case ( state.hover, state.click ) of ( Just item, Nothing ) -> Just ( item, Hover ) ( _, Just { item, moved } ) -> - if moved then - Just ( item, Drag ) + case moved of + Just _ -> + Just ( item, Drag ) - else - Just ( item, Click ) + Nothing -> + Just ( item, Click ) _ -> Nothing -type State item +type State item zone = S { hover : Maybe item - , click : Maybe (ClickState item) + , click : Maybe (ClickState item zone) } -type alias ClickState item = +type alias ClickState item zone = { item : item , pos : Vec2 - , moved : Bool + , abs : Vec2 + , moved : Maybe ( Vec2, zone ) , keys : Mouse.Keys } -init : State item +init : State item zone init = S { hover = Nothing @@ -64,8 +62,8 @@ init = type Msg item zone = HoverIn item | HoverOut - | StartClick item Vec2 Mouse.Keys - | ClickMove zone Vec2 + | StartClick item Vec2 Vec2 Mouse.Keys -- offsetPos clientPos + | ClickMove zone Vec2 Vec2 | EndClick | AbortClick | NOOP @@ -77,14 +75,14 @@ map f m = HoverIn a -> HoverIn (f a) - StartClick a v k -> - StartClick (f a) v k + StartClick a v c k -> + StartClick (f a) v c k HoverOut -> HoverOut - ClickMove z v -> - ClickMove z v + ClickMove z v c -> + ClickMove z v c EndClick -> EndClick @@ -104,13 +102,22 @@ type alias Event item zone = type Action zone = Clicked ( Bool, Bool, Bool ) - | Dragged Vec2 Vec2 ( Bool, Bool, Bool ) zone -- oldPos newPos + | Dragged (DragInfo zone) zone ( Bool, Bool, Bool ) -- Shift Ctrl Alt | DragIn | DragOut | DragEnded Bool -- True for Up, False for Abort -update : Msg item zone -> State item -> ( State item, Maybe (Event item zone) ) +type alias DragInfo zone = + { init : ( Vec2, zone ) + , oldPos : Vec2 + , newPos : Vec2 + , startD : Vec2 + , absD : Vec2 + } + + +update : Msg item zone -> State item zone -> ( State item zone, Maybe (Event item zone) ) update msg (S state) = case msg of HoverIn id -> @@ -128,14 +135,35 @@ update msg (S state) = Nothing -> ( S state, Nothing ) - StartClick id pos keys -> - ( S { state | click = Just <| ClickState id pos False keys }, Nothing ) + StartClick id pos abs keys -> + ( S { state | click = Just <| ClickState id pos abs Nothing keys }, Nothing ) - ClickMove zone pos -> + ClickMove zone pos abs -> case state.click of Just click -> - ( S { state | click = Just { click | pos = pos, moved = True } } - , Just <| Event (Dragged click.pos pos (tupleFromKeys click.keys) zone) click.item + let + dragInit = + Maybe.withDefault ( click.pos, zone ) click.moved + in + ( S + { state + | click = + Just { click | pos = pos, abs = abs, moved = Just dragInit } + } + , Just <| + Event + (Dragged + { init = dragInit + , oldPos = click.pos + , newPos = pos + , startD = Vec.sub abs click.abs + , absD = Vec.sub abs click.abs + } + zone + <| + tupleFromKeys click.keys + ) + click.item ) _ -> @@ -145,11 +173,12 @@ update msg (S state) = case state.click of Just { item, moved, keys } -> ( S { state | click = Nothing } - , if moved then - Just <| Event (DragEnded True) item + , case moved of + Just _ -> + Just <| Event (DragEnded True) item - else - Just <| Event (Clicked <| tupleFromKeys keys) item + Nothing -> + Just <| Event (Clicked <| tupleFromKeys keys) item ) _ -> @@ -159,11 +188,12 @@ update msg (S state) = case state.click of Just { item, moved, keys } -> ( S { state | click = Nothing } - , if moved then - Just <| Event (DragEnded False) item + , case moved of + Just _ -> + Just <| Event (DragEnded False) item - else - Nothing + Nothing -> + Nothing ) _ -> @@ -173,7 +203,7 @@ update msg (S state) = ( S state, Nothing ) -subs : State item -> List (Sub (Msg item zone)) +subs : State item zone -> List (Sub (Msg item zone)) subs (S { click }) = case click of Nothing -> @@ -194,14 +224,14 @@ subs (S { click }) = ] -dragSpaceEvents : State item -> zone -> List (Html.Attribute (Msg item zone)) +dragSpaceEvents : State item zone -> zone -> List (Html.Attribute (Msg item zone)) dragSpaceEvents (S { click }) zone = case click of Nothing -> [] Just _ -> - [ Mouse.onMove <| ClickMove zone << vecFromTuple << .offsetPos ] + [ Mouse.onMove <| \{ offsetPos, clientPos } -> ClickMove zone (vecFromTuple offsetPos) (vecFromTuple clientPos) ] hoverEvents : item -> List (Html.Attribute (Msg item zone)) @@ -214,7 +244,7 @@ hoverEvents id = 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 + \e -> StartClick id (vecFromTuple e.offsetPos) (vecFromTuple e.clientPos) e.keys ] diff --git a/src/Pack.elm b/src/Pack.elm index 764e5a9..0b3809a 100644 --- a/src/Pack.elm +++ b/src/Pack.elm @@ -165,9 +165,10 @@ view : -> List (Html.Attribute msg) -> (Msg -> msg) -> (Id Packed -> inter) + -> inter -> (Interact.Msg inter zone -> msg) -> Element msg -view pack events wrap interactable wrapInteract = +view pack events wrap interactable surfaceInter wrapInteract = if pack.visible then el ([ Border.color <| rgb 0 0 0 @@ -184,7 +185,11 @@ view pack events wrap interactable wrapInteract = ) <| html <| - S.svg (List.map (Html.Attributes.map (wrap << SvgMsg)) <| PanSvg.svgAttributes pack.svg) <| + S.svg + ((List.map (Html.Attributes.map (wrap << SvgMsg)) <| PanSvg.svgAttributes pack.svg) + ++ (List.map (Html.Attributes.map wrapInteract) <| Interact.draggableEvents surfaceInter) + ) + <| List.map (\( id, p ) -> Svg.map wrapInteract <| diff --git a/src/PanSvg.elm b/src/PanSvg.elm index 7cd500c..4374d68 100644 --- a/src/PanSvg.elm +++ b/src/PanSvg.elm @@ -77,6 +77,7 @@ type Msg | SetSmallestSize Float | ZoomPoint Float ( Float, Float ) | Pan Direction + | Move Vec2 type Direction @@ -145,6 +146,13 @@ update msg model = } } + Move d -> + let + viewPos = + model.viewPos + in + { model | viewPos = { viewPos | c = Vec.sub viewPos.c d } } + svgAttributes : Model -> List (Svg.Attribute Msg) svgAttributes model = From 59caaf238fff46df3a30a9776533defdd4bdcb08 Mon Sep 17 00:00:00 2001 From: cbossut Date: Thu, 27 Feb 2020 14:34:36 +0100 Subject: [PATCH 03/11] Pan with D shortcut --- src/Editor/Mobile.elm | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/Editor/Mobile.elm b/src/Editor/Mobile.elm index bf1c596..5eafcec 100644 --- a/src/Editor/Mobile.elm +++ b/src/Editor/Mobile.elm @@ -1632,7 +1632,12 @@ manageInteractEvent event model mobile = { return | model = ret.model, mobile = ret.mobile, toUndo = ret.toUndo } _ -> - return + case ( event.item, event.action ) of + ( ISurface, Interact.Dragged { startD } _ _ ) -> + { return | model = { model | svg = PanSvg.update (PanSvg.Move startD) model.svg } } + + _ -> + return SelectMotor -> case ( event.item, event.action ) of From 408ec7342ec70e07c6d3b1b98a91b69c04664df9 Mon Sep 17 00:00:00 2001 From: cbossut Date: Sat, 29 Feb 2020 17:17:13 +0100 Subject: [PATCH 04/11] See Wheel name on hover --- src/Data/Wheel.elm | 353 ++++++++++++++++++++++-------------------- src/Editor/Mobile.elm | 7 + 2 files changed, 195 insertions(+), 165 deletions(-) diff --git a/src/Data/Wheel.elm b/src/Data/Wheel.elm index e24d541..10b8316 100644 --- a/src/Data/Wheel.elm +++ b/src/Data/Wheel.elm @@ -12,7 +12,7 @@ import Sound import TypedSvg as S import TypedSvg.Attributes as SA import TypedSvg.Core exposing (..) -import TypedSvg.Types exposing (Fill(..), Length(..), Opacity(..), Transform(..)) +import TypedSvg.Types exposing (AnchorAlignment(..), Fill(..), Length(..), Opacity(..), Transform(..)) type alias Wheeled a = @@ -90,6 +90,7 @@ type alias Style = , motor : Bool , dashed : Bool , baseColor : Maybe Color + , named : Bool } @@ -99,6 +100,7 @@ defaultStyle = , motor = False , dashed = False , baseColor = Nothing + , named = True } @@ -186,187 +188,208 @@ view w pos lengthTmp style mayWheelInter mayHandleInter uid = (\( inter, l ) -> ( Interact.hoverEvents <| inter l, Interact.draggableEvents <| inter l )) mayWheelInter in - S.g - ([ SA.transform [ Translate (getX pos) (getY pos) ] ] - ++ hoverAttrs - ) - ([ S.g - (if String.isEmpty uid then - [] - - else - [ Html.Attributes.id uid ] ++ dragAttrs - ) - ([ S.circle - [ 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 <| - Num <| - if style.mod == Selectable then - tickW * 2 - - else - tickW - , SA.strokeDasharray <| - if style.dashed then - String.fromFloat (circum / 40 * 3 / 4) - ++ "," - ++ String.fromFloat (circum / 40 * 1 / 4) - - else - "" - , 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)) ] + S.g [ SA.transform [ Translate (getX pos) (getY pos) ] ] <| + (if style.named then + [ S.text_ + [ SA.x <| Num 0 + , SA.y <| Num -(length * 3 / 4) + , SA.fontSize <| Num (length / 2) + , SA.textAnchor AnchorMiddle + , SA.stroke Color.white + , SA.strokeWidth <| Num (tickW / 4) ] - [] - ] - ++ (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 - ] - [] - ] + [ text w.name ] + ] - Nothing -> + else + [] + ) + ++ [ S.g hoverAttrs <| + ([ S.g + -- rotation and drag + (if String.isEmpty uid then [] - ) - ++ (if viewContent then - case w.content of - C (Content.C collar) -> - let - scale = - lengthTmp / Content.getMatriceLength collar - in - [ S.g [ SA.transform [ Translate (-lengthTmp / 2) 0, Scale scale scale ] ] <| - insideCollarView collar mayWheelInter uid - ] - - _ -> - Debug.todo "view Sound or Mobile inside wheel" - - else - 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 - ] - [] - ] - _ -> - [] - ) - ) - ] - -- No drag events part - ++ (case style.mod of - Selected first -> - [ S.circle + else + [ Html.Attributes.id uid ] ++ dragAttrs + ) + ([ S.circle [ SA.cx <| Num 0 , SA.cy <| Num 0 - , SA.r <| Num (length / 2 + tickW * 2) - , SA.strokeWidth <| Num (tickW / 2) + , SA.r <| Num (length / 2) , SA.stroke <| - if first then + if style.motor then Color.red else Color.black - , SA.fill FillNone + , SA.strokeWidth <| + Num <| + if style.mod == Selectable then + tickW * 2 + + else + tickW + , SA.strokeDasharray <| + if style.dashed then + String.fromFloat (circum / 40 * 3 / 4) + ++ "," + ++ String.fromFloat (circum / 40 * 1 / 4) + + else + "" + , SA.fill <| + if w.mute then + Fill Color.white + + else + Fill w.color + , SA.fillOpacity <| Opacity (0.2 + 0.8 * w.volume) ] [] - ] - - Resizing -> - case mayHandleInter of - Just handle -> - [ S.polyline - [ SA.points [ ( -length / 2, 0 ), ( length / 2, 0 ) ] - , SA.stroke Color.red - , SA.strokeWidth <| Num tickW + , 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)) ] + ] + [] + ] + ++ (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 -> + [] + ) + ++ (if viewContent then + case w.content of + C (Content.C collar) -> + let + scale = + lengthTmp / Content.getMatriceLength collar + in + [ S.g [ SA.transform [ Translate (-lengthTmp / 2) 0, Scale scale scale ] ] <| + insideCollarView collar mayWheelInter uid + ] + + _ -> + Debug.todo "view Sound or Mobile inside wheel" + + else + 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 + ] + [] + ] + + _ -> + [] + ) + ) + + -- end rotation drag + ] + -- No drag events part + ++ (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 + ] + [] ] + + Resizing -> + case mayHandleInter of + Just handle -> + [ 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 (handle False) + ) + [] + , S.circle + ([ SA.cx <| Num (length / 2) + , SA.cy <| Num 0 + , SA.r <| Num (tickW * 2) + ] + ++ Interact.draggableEvents (handle True) + ) + [] + ] + + Nothing -> + [] + + _ -> [] - , S.circle - ([ SA.cx <| Num (-length / 2) - , SA.cy <| Num 0 - , SA.r <| Num (tickW * 2) - ] - ++ Interact.draggableEvents (handle False) - ) - [] - , S.circle - ([ SA.cx <| Num (length / 2) - , SA.cy <| Num 0 - , SA.r <| Num (tickW * 2) - ] - ++ Interact.draggableEvents (handle True) - ) - [] - ] + ) + ) + ] - Nothing -> - [] - _ -> - [] - ) - ) + +-- end hover insideCollarView : diff --git a/src/Editor/Mobile.elm b/src/Editor/Mobile.elm index 5eafcec..ce22c28 100644 --- a/src/Editor/Mobile.elm +++ b/src/Editor/Mobile.elm @@ -990,6 +990,13 @@ viewContent ( model, mobile ) = , baseColor = Maybe.map (\bId -> (Coll.get bId mobile.gears).wheel.color) <| Harmo.getBaseId g.harmony + , named = + case Interact.getInteract model.interact of + Just ( IWheel idd, _ ) -> + id == Tuple.first idd + + _ -> + False } (Just ( IWheel << Tuple.pair id, [] )) (Just <| IResizeHandle id) From 67d25a39cbe91b26ef614cbda64cf20187e986d8 Mon Sep 17 00:00:00 2001 From: cbossut Date: Sat, 29 Feb 2020 17:18:14 +0100 Subject: [PATCH 05/11] See fract on harmoLink hover --- src/Editor/Interacting.elm | 2 + src/Editor/Mobile.elm | 34 ++++++++++--- src/Link.elm | 101 ++++++++++++++++++++++++++----------- 3 files changed, 102 insertions(+), 35 deletions(-) diff --git a/src/Editor/Interacting.elm b/src/Editor/Interacting.elm index 01c8938..8f21625 100644 --- a/src/Editor/Interacting.elm +++ b/src/Editor/Interacting.elm @@ -3,6 +3,7 @@ module Editor.Interacting exposing (..) import Coll exposing (Id) import Data.Common exposing (Identifier) import Data.Mobile exposing (Geer) +import Link exposing (Link) import Pack exposing (Packed) import Sound exposing (Sound) @@ -13,6 +14,7 @@ type Interactable | IWheel Identifier | IResizeHandle (Id Geer) Bool -- True = right | IPacked (Id Packed) + | ILink (Link Geer) | ISound Sound diff --git a/src/Editor/Mobile.elm b/src/Editor/Mobile.elm index ce22c28..cc2c4d5 100644 --- a/src/Editor/Mobile.elm +++ b/src/Editor/Mobile.elm @@ -1023,6 +1023,7 @@ viewContent ( model, mobile ) = [ Link.drawRawLink ( g.pos, pos ) (Harmo.getLength g.harmony mobile.gears) + Link.baseColor ] _ -> @@ -1034,7 +1035,7 @@ viewContent ( model, mobile ) = Link.viewMotorLink False <| Gear.toDrawLink mobile.gears l Harmonize -> - Link.viewFractLink <| Gear.toDrawLink mobile.gears l + Link.viewFractLink (Gear.toDrawLink mobile.gears l) <| ILink l _ -> [] @@ -1085,13 +1086,34 @@ viewContent ( model, mobile ) = Motor.getAllLinks mobile.gears Harmonize -> - (List.concatMap (Link.viewFractLink << Gear.toDrawLink mobile.gears) <| - List.concatMap (.harmony >> Harmo.getLinks) <| - Coll.values mobile.gears + (case Interact.getInteract model.interact of + Just ( ILink l, _ ) -> + Link.viewFractOnLink (Gear.toDrawLink mobile.gears l) <| + Fract.simplify <| + Fract.division + (Coll.get (Tuple.second l) mobile.gears).harmony.fract + (Coll.get (Tuple.first l) mobile.gears).harmony.fract + + _ -> + [] ) + ++ (List.concatMap (\l -> Link.viewFractLink (Gear.toDrawLink mobile.gears l) (ILink l)) <| + List.concatMap (.harmony >> Harmo.getLinks) <| + Coll.values mobile.gears + ) ++ (case model.link of - Just { link } -> - Link.viewSelectedLink <| Gear.toDrawLink mobile.gears link + Just { link, fractInput } -> + Link.viewSelectedLink (Gear.toDrawLink mobile.gears link) <| + case fractInput of + FractionInput _ -> + Just <| + Fract.simplify <| + Fract.division + (Coll.get (Tuple.second link) mobile.gears).harmony.fract + (Coll.get (Tuple.first link) mobile.gears).harmony.fract + + TextInput _ -> + Nothing _ -> [] diff --git a/src/Link.elm b/src/Link.elm index 44e1122..231e175 100644 --- a/src/Link.elm +++ b/src/Link.elm @@ -1,16 +1,22 @@ module Link exposing (..) import Coll exposing (Coll, Id) -import Color -import Fraction as Fract exposing (Fraction) +import Color exposing (Color) +import Fraction exposing (Fraction) +import Interact import Json.Decode as D import Json.Decode.Field as Field import Json.Encode as E import Math.Vector2 as Vec exposing (Vec2, vec2) import TypedSvg as S import TypedSvg.Attributes as SA -import TypedSvg.Core exposing (Svg) -import TypedSvg.Types exposing (Length(..), Transform(..)) +import TypedSvg.Core as Svg exposing (Svg) +import TypedSvg.Types exposing (AnchorAlignment(..), DominantBaseline(..), Length(..), Opacity(..), Transform(..)) + + +baseColor : Color +baseColor = + Color.brown type alias Link item = @@ -30,13 +36,66 @@ type alias DrawLink = ( Circle, Circle ) -viewFractLink : DrawLink -> List (Svg msg) -viewFractLink ( e, f ) = - [ drawRawLink ( e.c, f.c ) <| - ((e.d + f.d) / 2) +viewFractLink : DrawLink -> inter -> List (Svg (Interact.Msg inter zone)) +viewFractLink ( e, f ) inter = + [ drawRawLink ( e.c, f.c ) ((e.d + f.d) / 2) baseColor + , S.polyline + (Interact.hoverEvents inter + ++ [ SA.points [ tupleFromVec e.c, tupleFromVec f.c ] + , SA.strokeWidth <| Num ((e.d + f.d) / 15) + , SA.strokeOpacity <| Opacity 0 + , SA.stroke Color.black + ] + ) + [] ] +viewFractOnLink : DrawLink -> Fraction -> List (Svg msg) +viewFractOnLink ( e, f ) { num, den } = + let + dir = + Vec.normalize <| Vec.sub f.c e.c + + center = + Vec.scale 0.5 <| Vec.add (Vec.add e.c <| Vec.scale (e.d / 2) dir) (Vec.sub f.c <| Vec.scale (f.d / 2) dir) + + d = + Vec.normalize <| + rotate90 (Vec.sub e.c f.c) <| + not <| + Vec.getX e.c + < Vec.getX f.c + || (Vec.getX e.c == Vec.getX f.c && Vec.getY e.c < Vec.getY f.c) + + size = + (e.d + f.d) / 10 + + txt mult i = + let + p = + Vec.add center <| Vec.scale (mult * size / 2) d + in + S.text_ + [ SA.x <| Num <| Vec.getX p + , SA.y <| Num <| Vec.getY p + , SA.fontSize <| Num size + , SA.textAnchor AnchorMiddle + , SA.dominantBaseline DominantBaselineCentral + , SA.stroke Color.white + , SA.strokeWidth <| Num (size / 40) + ] + [ Svg.text <| String.fromInt i ] + in + [ txt 1 num, txt -1 den ] + + +viewSelectedLink : DrawLink -> Maybe Fraction -> List (Svg msg) +viewSelectedLink ( e, f ) mayFract = + drawRawLink ( e.c, f.c ) ((e.d + f.d) / 2) Color.red + :: (Maybe.withDefault [] <| Maybe.map (viewFractOnLink ( e, f )) mayFract) + + viewMotorLink : Bool -> DrawLink -> List (Svg msg) viewMotorLink cutting ( e, f ) = [ S.g @@ -56,22 +115,6 @@ viewMotorLink cutting ( e, f ) = ] -viewSelectedLink : DrawLink -> List (Svg msg) -viewSelectedLink ( e, f ) = - let - w = - (e.d + f.d) / 30 - in - [ S.polyline - [ SA.points [ tupleFromVec <| e.c, tupleFromVec <| f.c ] - , SA.stroke Color.red - , SA.strokeWidth <| Num w - , SA.strokeLinecap TypedSvg.Types.StrokeLinecapRound - ] - [] - ] - - drawMotorLink : ( ( Vec2, Float ), ( Vec2, Float ) ) -> Svg msg drawMotorLink ( ( p1, d1 ), ( p2, d2 ) ) = let @@ -86,16 +129,16 @@ drawMotorLink ( ( p1, d1 ), ( p2, d2 ) ) = d1 + d2 / 2 in S.g [] - [ drawRawLink ( contactPoint p1 d1 True, contactPoint p2 d2 True ) gearL - , drawRawLink ( contactPoint p1 d1 False, contactPoint p2 d2 False ) gearL + [ drawRawLink ( contactPoint p1 d1 True, contactPoint p2 d2 True ) gearL baseColor + , drawRawLink ( contactPoint p1 d1 False, contactPoint p2 d2 False ) gearL baseColor ] -drawRawLink : ( Vec2, Vec2 ) -> Float -> Svg msg -drawRawLink ( p1, p2 ) gearL = +drawRawLink : ( Vec2, Vec2 ) -> Float -> Color -> Svg msg +drawRawLink ( p1, p2 ) gearL c = S.polyline [ SA.points [ tupleFromVec p1, tupleFromVec p2 ] - , SA.stroke Color.brown + , SA.stroke c , SA.strokeWidth <| Num (gearL / 30) , SA.strokeLinecap TypedSvg.Types.StrokeLinecapRound ] From 8b3f4325a0fa9ee8d8dddf0c8784e1dc6285adba Mon Sep 17 00:00:00 2001 From: cbossut Date: Sat, 29 Feb 2020 19:37:32 +0100 Subject: [PATCH 06/11] =?UTF-8?q?Don=E2=80=99t=20apply=20volume=20opacity?= =?UTF-8?q?=20if=20wheel=20is=20muted?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Data/Wheel.elm | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/src/Data/Wheel.elm b/src/Data/Wheel.elm index 10b8316..940cb06 100644 --- a/src/Data/Wheel.elm +++ b/src/Data/Wheel.elm @@ -214,23 +214,23 @@ view w pos lengthTmp style mayWheelInter mayHandleInter uid = [ Html.Attributes.id uid ] ++ dragAttrs ) ([ 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) ++ "," @@ -238,14 +238,16 @@ view w pos lengthTmp style mayWheelInter mayHandleInter uid = else "" - , SA.fill <| - if w.mute then - Fill Color.white + ] + ++ (if w.mute then + [ SA.fill <| Fill Color.white ] - else - Fill w.color - , SA.fillOpacity <| Opacity (0.2 + 0.8 * w.volume) - ] + else + [ SA.fill <| Fill w.color + , SA.fillOpacity <| Opacity (0.2 + 0.8 * w.volume) + ] + ) + ) [] , S.rect [ SA.width <| Num tickW From 64988b009853310fbbb48f099d236576ba420dea Mon Sep 17 00:00:00 2001 From: cbossut Date: Sat, 29 Feb 2020 19:37:54 +0100 Subject: [PATCH 07/11] Fix volume drag inverted --- src/Editor/Mobile.elm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Editor/Mobile.elm b/src/Editor/Mobile.elm index cc2c4d5..efb5500 100644 --- a/src/Editor/Mobile.elm +++ b/src/Editor/Mobile.elm @@ -1539,7 +1539,7 @@ doVolumeChange : doVolumeChange id absD mobile engine = let volume = - (CommonData.getWheel id mobile).volume + Vec.getY absD / 100 + (CommonData.getWheel id mobile).volume - Vec.getY absD / 100 in { mobile = CommonData.updateWheel id (Wheel.ChangeVolume volume) mobile , toUndo = Group From 6628482212826d8b4a9c31b92b4030be420b7337 Mon Sep 17 00:00:00 2001 From: cbossut Date: Sat, 29 Feb 2020 22:29:46 +0100 Subject: [PATCH 08/11] Alternate --- elm.json | 2 +- src/Editor/Mobile.elm | 115 +++++++++++++++++++++++++++++++++++++++++- 2 files changed, 114 insertions(+), 3 deletions(-) diff --git a/elm.json b/elm.json index 509dfe9..622ba4a 100644 --- a/elm.json +++ b/elm.json @@ -17,6 +17,7 @@ "elm/json": "1.1.3", "elm/random": "1.0.0", "elm/svg": "1.0.1", + "elm/time": "1.0.0", "elm/url": "1.0.0", "elm-community/typed-svg": "5.1.0", "elm-community/undo-redo": "3.0.0", @@ -33,7 +34,6 @@ "indirect": { "elm/bytes": "1.0.8", "elm/regex": "1.0.0", - "elm/time": "1.0.0", "elm/virtual-dom": "1.0.2", "kuon/elm-string-normalize": "1.0.1" } diff --git a/src/Editor/Mobile.elm b/src/Editor/Mobile.elm index efb5500..d3080a4 100644 --- a/src/Editor/Mobile.elm +++ b/src/Editor/Mobile.elm @@ -30,6 +30,7 @@ import PanSvg import Random import Round import Sound exposing (Sound) +import Time import TypedSvg as S import TypedSvg.Attributes as SA import TypedSvg.Core as Svg exposing (Svg) @@ -52,6 +53,16 @@ svgId = "svg" +blinkOnTime : Float +blinkOnTime = + 800 + + +blinkOffTime : Float +blinkOffTime = + 200 + + type alias Model = { dragging : Dragging , tool : Tool @@ -89,6 +100,7 @@ type Mode | SupprMode | Move | SelectMotor + | Alternate keyCodeToMode : List ( String, Mode ) @@ -97,6 +109,7 @@ keyCodeToMode = , ( "KeyV", Nav ) , ( "Delete", SupprMode ) , ( "Backspace", SupprMode ) + , ( "KeyQ", Alternate ) ] @@ -114,6 +127,7 @@ type Dragging | HalfLink ( Id Geer, Vec2 ) | CompleteLink (Link Geer) | Cut ( Vec2, Vec2 ) (List (Link Geer)) + | Alterning Identifier (Maybe Identifier) BlinkState | VolumeChange | SizeChange | Moving @@ -123,6 +137,10 @@ type Dragging | ChgContent (Id Geer) Dragging +type alias BlinkState = + ( Bool, Float ) + + getShared : Model -> ( Pack, PanSvg.Model ) getShared { pack, svg } = ( pack, svg ) @@ -180,6 +198,7 @@ type Msg | Capsuled (List (Id Geer)) | Collared (Id Geer) | UnCollar (Id Geer) + | Blink | InteractMsg (Interact.Msg Interactable Zone) | SvgMsg PanSvg.Msg | SVGSize (Result D.Error PanSvg.Size) @@ -701,6 +720,27 @@ update msg ( model, mobile ) = _ -> return + Blink -> + case model.dragging of + Alterning x y ( b, _ ) -> + { return + | model = + { model + | dragging = + Alterning x y <| + ( not b + , if b then + blinkOffTime + + else + blinkOnTime + ) + } + } + + _ -> + return + WheelMsgs msgs -> { return | mobile = @@ -816,11 +856,18 @@ update msg ( model, mobile ) = subs : Model -> List (Sub Msg) -subs { interact } = +subs { interact, dragging } = PanSvg.newSVGSize (SVGSize << D.decodeValue PanSvg.sizeDecoder) :: Sub.map WaveMsg Waveform.sub :: (gotRecord <| (GotRecord << D.decodeValue D.string)) :: (List.map (Sub.map InteractMsg) <| Interact.subs interact) + ++ (case dragging of + Alterning _ _ ( _, t ) -> + [ Time.every t <| always <| Blink ] + + _ -> + [] + ) viewTools : Model -> Element Msg @@ -981,7 +1028,33 @@ viewContent ( model, mobile ) = List.map (Svg.map InteractMsg) <| (List.map (\( id, g ) -> - Wheel.view g.wheel + let + -- TODO should blink also if bead + wheel = + g.wheel + + w = + case model.dragging of + Alterning ( idd, [] ) mayId ( b, _ ) -> + if not b && id == idd then + { wheel | mute = not wheel.mute } + + else + case mayId of + Just ( iid, [] ) -> + if not b && id == iid then + { wheel | mute = not wheel.mute } + + else + wheel + + _ -> + wheel + + _ -> + wheel + in + Wheel.view w g.pos (Harmo.getLength g.harmony mobile.gears) { mod = getMod id @@ -1700,6 +1773,44 @@ manageInteractEvent event model mobile = _ -> return + Alternate -> + case model.tool of + Play _ _ -> + case ( event.item, event.action, model.dragging ) of + ( IWheel id, Interact.Dragged _ _ _, NoDrag ) -> + { return | model = { model | dragging = Alterning id Nothing ( False, blinkOffTime ) } } + + ( IWheel id, Interact.DragIn, Alterning other _ b ) -> + { return | model = { model | dragging = Alterning other (Just id) b } } + + ( IWheel _, Interact.DragOut, Alterning other _ b ) -> + { return + | model = + { model + | dragging = Alterning other Nothing b + } + } + + ( _, Interact.DragEnded True, Alterning id1 (Just id2) _ ) -> + { return + | model = { model | dragging = NoDrag } + , mobile = + List.foldl + (\id mob -> CommonData.updateWheel id Wheel.ToggleMute mob) + mobile + [ id1, id2 ] + , toUndo = Do + } + + ( _, Interact.DragEnded _, _ ) -> + { return | model = { model | dragging = NoDrag } } + + _ -> + return + + _ -> + return + Normal -> case ( event.item, event.action, model.dragging ) of -- FROM SOUNDLIST From f6773f69e98625b4268f8e917f7f567468a414d5 Mon Sep 17 00:00:00 2001 From: cbossut Date: Sun, 1 Mar 2020 01:32:21 +0100 Subject: [PATCH 09/11] Solo --- src/Data/Wheel.elm | 4 ++ src/Editor/Mobile.elm | 27 +++++++++++++ src/Interact.elm | 88 +++++++++++++++++++++++++++++++++---------- 3 files changed, 100 insertions(+), 19 deletions(-) diff --git a/src/Data/Wheel.elm b/src/Data/Wheel.elm index 940cb06..6d84e20 100644 --- a/src/Data/Wheel.elm +++ b/src/Data/Wheel.elm @@ -108,6 +108,7 @@ type Msg = ChangeContent Conteet | ChangeVolume Float | ToggleMute + | Mute Bool | ChangeStart Float | Named String | ChangeColor Color @@ -130,6 +131,9 @@ update msg g = ToggleMute -> { g | wheel = { wheel | mute = not wheel.mute } } + Mute b -> + { g | wheel = { wheel | mute = b } } + ChangeStart percent -> { g | wheel = { wheel | startPercent = percent } } diff --git a/src/Editor/Mobile.elm b/src/Editor/Mobile.elm index d3080a4..2706648 100644 --- a/src/Editor/Mobile.elm +++ b/src/Editor/Mobile.elm @@ -101,6 +101,7 @@ type Mode | Move | SelectMotor | Alternate + | Solo keyCodeToMode : List ( String, Mode ) @@ -110,6 +111,7 @@ keyCodeToMode = , ( "Delete", SupprMode ) , ( "Backspace", SupprMode ) , ( "KeyQ", Alternate ) + , ( "KeyS", Solo ) ] @@ -1773,6 +1775,31 @@ manageInteractEvent event model mobile = _ -> return + Solo -> + case model.tool of + Play _ _ -> + case ( event.item, event.action ) of + ( IWheel ( id, [] ), Interact.Holded ) -> + -- TODO should work also for beads (not []), Mobile.mapWheels ? + { return + | mobile = + List.foldl + (\( idd, g ) -> CommonData.updateWheel ( idd, [] ) <| (Wheel.Mute <| idd /= id)) + mobile + <| + Coll.toList mobile.gears + , toUndo = Group + } + + ( IWheel ( id, [] ), Interact.HoldEnded ) -> + { return | toUndo = Cancel } + + _ -> + return + + _ -> + return + Alternate -> case model.tool of Play _ _ -> diff --git a/src/Interact.elm b/src/Interact.elm index bd39aad..34763b0 100644 --- a/src/Interact.elm +++ b/src/Interact.elm @@ -5,6 +5,12 @@ import Html import Html.Events.Extra.Mouse as Mouse import Json.Decode as D import Math.Vector2 as Vec exposing (Vec2, vec2) +import Time + + +holdTime : Float +holdTime = + 500 type alias Interact item = @@ -14,21 +20,25 @@ type alias Interact item = type Mode = Hover | Click + | Hold | Drag getInteract : State item zone -> Interact item -getInteract (S state) = - case ( state.hover, state.click ) of +getInteract (S s) = + case ( s.hover, s.click ) of ( Just item, Nothing ) -> Just ( item, Hover ) - ( _, Just { item, moved } ) -> - case moved of - Just _ -> + ( _, Just { item, hold } ) -> + case hold of + Moving _ -> Just ( item, Drag ) - Nothing -> + Holding -> + Just ( item, Hold ) + + Clicking -> Just ( item, Click ) _ -> @@ -46,11 +56,17 @@ type alias ClickState item zone = { item : item , pos : Vec2 , abs : Vec2 - , moved : Maybe ( Vec2, zone ) + , hold : HoldState zone , keys : Mouse.Keys } +type HoldState zone + = Clicking + | Holding + | Moving ( Vec2, zone ) + + init : State item zone init = S @@ -64,6 +80,7 @@ type Msg item zone | HoverOut | StartClick item Vec2 Vec2 Mouse.Keys -- offsetPos clientPos | ClickMove zone Vec2 Vec2 + | ClickHold | EndClick | AbortClick | NOOP @@ -84,6 +101,9 @@ map f m = ClickMove z v c -> ClickMove z v c + ClickHold -> + ClickHold + EndClick -> EndClick @@ -106,6 +126,8 @@ type Action zone | DragIn | DragOut | DragEnded Bool -- True for Up, False for Abort + | Holded + | HoldEnded type alias DragInfo zone = @@ -136,19 +158,24 @@ update msg (S state) = ( S state, Nothing ) StartClick id pos abs keys -> - ( S { state | click = Just <| ClickState id pos abs Nothing keys }, Nothing ) + ( S { state | click = Just <| ClickState id pos abs Clicking keys }, Nothing ) ClickMove zone pos abs -> case state.click of Just click -> let dragInit = - Maybe.withDefault ( click.pos, zone ) click.moved + case click.hold of + Moving res -> + res + + _ -> + ( click.pos, zone ) in ( S { state | click = - Just { click | pos = pos, abs = abs, moved = Just dragInit } + Just { click | pos = pos, abs = abs, hold = Moving dragInit } } , Just <| Event @@ -169,15 +196,28 @@ update msg (S state) = _ -> ( S state, Nothing ) + ClickHold -> + case state.click of + Just click -> + ( S { state | click = Just { click | hold = Holding } } + , Just <| Event Holded click.item + ) + + _ -> + ( S state, Nothing ) + EndClick -> case state.click of - Just { item, moved, keys } -> + Just { item, hold, keys } -> ( S { state | click = Nothing } - , case moved of - Just _ -> + , case hold of + Moving _ -> Just <| Event (DragEnded True) item - Nothing -> + Holding -> + Just <| Event HoldEnded item + + Clicking -> Just <| Event (Clicked <| tupleFromKeys keys) item ) @@ -186,13 +226,16 @@ update msg (S state) = AbortClick -> case state.click of - Just { item, moved, keys } -> + Just { item, hold, keys } -> ( S { state | click = Nothing } - , case moved of - Just _ -> + , case hold of + Moving _ -> Just <| Event (DragEnded False) item - Nothing -> + Holding -> + Just <| Event HoldEnded item + + Clicking -> Nothing ) @@ -209,7 +252,7 @@ subs (S { click }) = Nothing -> [] - Just _ -> + Just { hold } -> [ BE.onMouseUp <| D.succeed <| EndClick , BE.onVisibilityChange (\v -> @@ -222,6 +265,13 @@ subs (S { click }) = NOOP ) ] + ++ (case hold of + Clicking -> + [ Time.every holdTime <| always ClickHold ] + + _ -> + [] + ) dragSpaceEvents : State item zone -> zone -> List (Html.Attribute (Msg item zone)) From d2d9d3e001009625a98d2f965b52fcd553d7de26 Mon Sep 17 00:00:00 2001 From: cbossut Date: Sun, 1 Mar 2020 01:38:21 +0100 Subject: [PATCH 10/11] beautify dir in lib --- src/Main.elm | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/Main.elm b/src/Main.elm index 339ee6e..c92381b 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -845,14 +845,16 @@ viewDirInLib : Model -> String -> List String -> Dict String SoundListType -> Bo viewDirInLib model str id dict opened = Input.button [ Font.color <| rgb 1 1 1 ] { label = - text <| - (if opened then - "▽" + el [ Font.bold ] <| + text <| + (if opened then + "▽" - else - "◿" - ) - ++ str + else + "◿" + ) + ++ " " + ++ str , onPress = Just <| ExpandDir id } :: (if opened then From 6ff54029c9235bc8728fe392b9b37d28af3c7c6a Mon Sep 17 00:00:00 2001 From: cbossut Date: Sun, 1 Mar 2020 14:40:32 +0100 Subject: [PATCH 11/11] Color edition --- src/Editor/Mobile.elm | 67 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 67 insertions(+) diff --git a/src/Editor/Mobile.elm b/src/Editor/Mobile.elm index 2706648..0a45735 100644 --- a/src/Editor/Mobile.elm +++ b/src/Editor/Mobile.elm @@ -8,6 +8,7 @@ import Data.Content as Content exposing (Content) import Data.Gear as Gear import Data.Mobile as Mobile exposing (Geer, Mobeel) import Data.Wheel as Wheel exposing (Conteet, Wheel) +import Dict import Editor.Interacting exposing (Interactable(..), Zone(..)) import Element exposing (..) import Element.Background as Bg @@ -18,7 +19,9 @@ import Engine exposing (Engine) import File.Download as DL import Fraction as Fract exposing (Fraction) import Harmony as Harmo +import Html import Html.Attributes +import Html.Events import Interact exposing (Interact) import Json.Decode as D import Json.Encode as E @@ -1468,6 +1471,32 @@ viewEditDetails model mobile = Nothing -> [] ) + ++ [ row [] + [ text "Couleur : " + , html <| + Html.input + [ Html.Attributes.type_ "color" + , Html.Attributes.value <| colorToString g.wheel.color + , Html.Events.onInput + (\str -> + WheelMsgs + [ ( wId + , Wheel.ChangeColor <| + Color.fromRgba + { red = hexToFloat <| String.slice 1 3 str + , green = hexToFloat <| String.slice 3 5 str + , blue = hexToFloat <| String.slice 5 7 str + , alpha = 1 + } + ) + ] + ) + + -- TODO should Group undo with onChange event as final Do + ] + [] + ] + ] , text <| "Durée : " ++ Harmo.view id @@ -2210,3 +2239,41 @@ interactMove event model mobile = colorGen : Random.Generator Color.Color colorGen = Random.map (\f -> Color.hsl f 1 0.5) <| Random.float 0 1 + + +colorToString : Color.Color -> String +colorToString c = + let + { red, blue, green } = + Color.toRgba c + in + "#" ++ floatToHex red ++ floatToHex green ++ floatToHex blue + + +hexDigits : List String +hexDigits = + [ "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c", "d", "e", "f" ] + + +intToHex : Int -> String +intToHex i = + Maybe.withDefault "0" <| Dict.get i <| Dict.fromList <| List.indexedMap Tuple.pair hexDigits + + +floatToHex : Float -> String +floatToHex f = + let + i = + round (f * 255) + in + intToHex (i // 16) ++ intToHex (modBy 16 i) + + +hexToInt : String -> Int +hexToInt s = + Maybe.withDefault 0 <| Dict.get s <| Dict.fromList <| List.indexedMap (\i c -> ( c, i )) hexDigits + + +hexToFloat : String -> Float +hexToFloat s = + toFloat (hexToInt (String.slice 0 1 s) * 16 + (hexToInt <| String.slice 1 2 s)) / 255