compile Drg messages/model into a single concept
we can only drag one thing at a time anyway
This commit is contained in:
parent
f4a9314033
commit
9fd3620d9b
@ -126,27 +126,35 @@ boundingTiles centre z width height =
|
||||
|
||||
-- MODEL
|
||||
|
||||
type DragTarget = Map | Graph | StartMark | EndMark
|
||||
|
||||
type Drag
|
||||
= None
|
||||
| Dragging (Int, Int) (Int, Int)
|
||||
| Dragging DragTarget (Int, Int) (Int, Int)
|
||||
|
||||
|
||||
dragTo : Drag -> (Int, Int) -> Drag
|
||||
dragTo d dest =
|
||||
case d of
|
||||
None -> None
|
||||
Dragging from to -> Dragging from dest
|
||||
Dragging target from to -> Dragging target from dest
|
||||
|
||||
dragDelta d =
|
||||
dragDelta target d =
|
||||
case d of
|
||||
None -> (0,0)
|
||||
Dragging (fx,fy) (tx,ty) -> (fx-tx, fy-ty)
|
||||
Dragging target_ (fx,fy) (tx,ty) ->
|
||||
if target == target_
|
||||
then (fx-tx, fy-ty)
|
||||
else (0, 0)
|
||||
_ -> (0, 0)
|
||||
|
||||
subTuple (fx,fy) (tx,ty) = (fx-tx, fy-ty)
|
||||
|
||||
|
||||
type TrackState = Empty | Loading | Failure String | Present (List Point)
|
||||
type alias Model =
|
||||
{ centre: Coord
|
||||
, zoom: FineZoomLevel
|
||||
, drag: Drag
|
||||
, timeDrag: Drag
|
||||
, startTime : Int
|
||||
, duration : Int
|
||||
, track: TrackState }
|
||||
@ -158,7 +166,7 @@ init _ url navKey =
|
||||
Just (Timeline (Just s) (Just d)) -> (s, d)
|
||||
_ -> (10,10)
|
||||
in
|
||||
((Model (toCoord 51.60 -0.01) (FineZoomLevel (13*8)) None None 0 0 Empty),
|
||||
((Model (toCoord 51.60 -0.01) (FineZoomLevel (13*8)) None 0 0 Empty),
|
||||
(fetchTrack start duration))
|
||||
|
||||
-- SUBSCRIPTIONS
|
||||
@ -181,13 +189,10 @@ fetchTrack start duration = Http.get
|
||||
|
||||
type Msg
|
||||
= MapScale Int
|
||||
| MapDragStart (Int, Int)
|
||||
| MapDrag (Int, Int)
|
||||
| MapDragFinish (Int, Int)
|
||||
| DragStart DragTarget (Int, Int)
|
||||
| Drag (Int, Int)
|
||||
| DragFinish (Int, Int)
|
||||
| TimeScale (Float)
|
||||
| TimeDragStart (Int, Int)
|
||||
| TimeDrag (Int, Int)
|
||||
| TimeDragFinish (Int, Int)
|
||||
| Loaded (Result Http.Error (List Point))
|
||||
| NewUrlRequest
|
||||
| UrlChanged
|
||||
@ -202,16 +207,26 @@ updateModel msg model =
|
||||
MapScale y ->
|
||||
{ model | zoom = incZoom model.zoom y }
|
||||
|
||||
MapDragStart (x,y) ->
|
||||
{ model | drag = Dragging (x,y) (x,y) }
|
||||
DragStart target (x,y) ->
|
||||
{ model | drag = Dragging target (x,y) (x,y) }
|
||||
|
||||
MapDrag (x,y) ->
|
||||
Drag (x,y) ->
|
||||
{ model | drag = dragTo model.drag (x,y) }
|
||||
|
||||
MapDragFinish (x,y) ->
|
||||
{ model | drag = None,
|
||||
centre = translatePixels model.centre (toZoom model.zoom) (dragDelta model.drag) }
|
||||
|
||||
DragFinish (x,y) ->
|
||||
case model.drag of
|
||||
Dragging Map start end ->
|
||||
{ model |
|
||||
drag = None,
|
||||
centre = translatePixels model.centre (toZoom model.zoom) (subTuple start end) }
|
||||
Dragging Graph start end ->
|
||||
{ model |
|
||||
drag = None,
|
||||
startTime =
|
||||
let (delta, _) = subTuple start end
|
||||
in model.startTime + delta * model.duration // portalWidth
|
||||
}
|
||||
_ -> model
|
||||
TimeScale factor ->
|
||||
let fudge = factor
|
||||
len = model.duration - floor(fudge)
|
||||
@ -220,18 +235,6 @@ updateModel msg model =
|
||||
, duration = len
|
||||
}
|
||||
|
||||
TimeDragStart (x,y) ->
|
||||
{ model | timeDrag = Dragging (x,y) (x,y) }
|
||||
|
||||
TimeDrag (x,y) ->
|
||||
{ model | timeDrag = dragTo model.timeDrag (x,y) }
|
||||
|
||||
TimeDragFinish (x,y) ->
|
||||
{ model | timeDrag = None,
|
||||
startTime =
|
||||
let (delta, _) = dragDelta model.timeDrag
|
||||
in model.startTime + delta * model.duration // portalWidth
|
||||
}
|
||||
Loaded result ->
|
||||
case result of
|
||||
Ok trk ->
|
||||
@ -526,7 +529,7 @@ ifTrack : Model -> (List Point -> Html msg) -> Html msg
|
||||
ifTrack model content =
|
||||
case model.track of
|
||||
Present t ->
|
||||
let (dt, _) = dragDelta model.timeDrag
|
||||
let (dt, _) = dragDelta Graph model.drag
|
||||
dpix = dt * model.duration // portalWidth
|
||||
start = toFloat (model.startTime + dpix)
|
||||
points = Point.subseq t start (toFloat model.duration)
|
||||
@ -557,11 +560,12 @@ canvas centre zoom width height model =
|
||||
,style "left" (px -offsetX)
|
||||
,style "top" (px -offsetY)
|
||||
,style "lineHeight" (px 0)
|
||||
,Pointer.onUp (\e -> MapDragFinish (epos e))
|
||||
,Pointer.onMove (\e -> MapDrag (epos e))
|
||||
,Pointer.onDown (\e -> MapDragStart (epos e)) ]
|
||||
,Pointer.onUp (\e -> DragFinish (epos e))
|
||||
,Pointer.onMove (\e -> Drag (epos e))
|
||||
,Pointer.onDown (\e -> DragStart Map (epos e)) ]
|
||||
(tv :: tiles xs ys zoom)
|
||||
|
||||
|
||||
portalWidth = 600
|
||||
portalHeight = 600
|
||||
|
||||
@ -581,7 +585,7 @@ timeWheelDecoder =
|
||||
|
||||
viewDiv : Model -> Html Msg
|
||||
viewDiv model =
|
||||
let coord = translate model.centre (pixelsToCoord (toZoom model.zoom) (dragDelta model.drag))
|
||||
let coord = translate model.centre (pixelsToCoord (toZoom model.zoom) (dragDelta Map model.drag))
|
||||
canvasV = canvas coord (toZoom model.zoom) portalWidth portalHeight model
|
||||
epos e = Tuple.mapBoth floor floor e.pointer.clientPos
|
||||
in div [ style "display" "flex"
|
||||
@ -604,9 +608,9 @@ viewDiv model =
|
||||
]
|
||||
, div [ style "display" "flex"
|
||||
, Html.Events.custom "wheel" timeWheelDecoder
|
||||
, Pointer.onUp (\e -> TimeDragFinish (epos e))
|
||||
, Pointer.onMove (\e -> TimeDrag (epos e))
|
||||
, Pointer.onDown (\e -> TimeDragStart (epos e))
|
||||
, Pointer.onUp (\e -> DragFinish (epos e))
|
||||
, Pointer.onMove (\e -> Drag (epos e))
|
||||
, Pointer.onDown (\e -> DragStart Graph (epos e))
|
||||
, style "flex-direction" "column"
|
||||
, style "row-gap" "10px"
|
||||
]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user