basic drag and drop

master
Brian Hicks 2020-02-17 16:09:21 -06:00
parent 7e2db6d8c7
commit ee4db506c8
3 changed files with 68 additions and 16 deletions

View File

@ -8,10 +8,10 @@
"direct": {
"elm/browser": "1.0.2",
"elm/core": "1.0.5",
"elm/html": "1.0.0"
"elm/html": "1.0.0",
"elm/json": "1.1.3"
},
"indirect": {
"elm/json": "1.1.3",
"elm/time": "1.0.0",
"elm/url": "1.0.0",
"elm/virtual-dom": "1.0.2"

View File

@ -2,6 +2,7 @@ module Attachment exposing (Attachment, init, view)
import Html exposing (Html)
import Html.Attributes as Attrs
import Html.Events as Events
type alias Attachment =
@ -13,8 +14,8 @@ init =
Attachment << abs
view : Int -> Attachment -> Html msg
view left { top } =
view : Attachment -> Html msg
view _ =
Html.div
[ Attrs.style "width" "15px"
, Attrs.style "height" "15px"
@ -22,10 +23,5 @@ view left { top } =
, Attrs.style "border-radius" "100%"
, Attrs.style "background-color" "white"
, Attrs.style "cursor" "pointer"
-- position
, Attrs.style "position" "absolute"
, Attrs.style "left" (String.fromInt left ++ "px")
, Attrs.style "top" (String.fromInt top ++ "px")
]
[]

View File

@ -2,33 +2,67 @@ module Main exposing (..)
import Attachment exposing (Attachment)
import Browser
import Browser.Events
import Comment exposing (Comment)
import Dict exposing (Dict)
import Html exposing (Html)
import Html.Attributes as Attrs
import Html.Events
import Json.Decode as Decode
type alias Model =
{ attachments : List Attachment
{ attachments : Dict Int Attachment
, comments : List Comment
, dragging : Maybe Int
}
type Msg
= AddNewCommentAndAttachment
= MouseDownOnAttachment Int
| MouseUp
| MouseMove Int
init : () -> ( Model, Cmd Msg )
init _ =
( { attachments = []
( { attachments =
Dict.fromList
[ ( 1, Attachment 20 )
, ( 2, Attachment 40 )
, ( 3, Attachment 100 )
]
, comments = []
, dragging = Nothing
}
, Cmd.none
)
update : Msg -> Model -> ( Model, Cmd Msg )
update _ _ =
Debug.todo "update"
update msg model =
case msg of
MouseDownOnAttachment id ->
( { model | dragging = Just id }, Cmd.none )
MouseUp ->
( { model | dragging = Nothing }, Cmd.none )
MouseMove top ->
case model.dragging of
Just id ->
( { model
| attachments =
Dict.update
id
(Maybe.map (\attachment -> { attachment | top = top }))
model.attachments
}
, Cmd.none
)
Nothing ->
( model, Cmd.none )
view : Model -> Browser.Document Msg
@ -57,7 +91,20 @@ view model =
[]
]
-- attachments
++ List.map (Attachment.view horizMargin) model.attachments
++ List.map
(\( id, attachment ) ->
Html.div
[ Html.Events.onMouseDown (MouseDownOnAttachment id)
-- position
, Attrs.style "position" "absolute"
, Attrs.style "left" (String.fromInt horizMargin ++ "px")
, Attrs.style "top" (String.fromInt attachment.top ++ "px")
]
[ Attachment.view attachment
]
)
(Dict.toList model.attachments)
-- comments
++ List.map Comment.view model.comments
)
@ -71,5 +118,14 @@ main =
{ init = init
, update = update
, view = view
, subscriptions = \_ -> Sub.none
, subscriptions =
\{ dragging } ->
Sub.batch
[ Browser.Events.onMouseUp (Decode.succeed MouseUp)
, if dragging /= Nothing then
Browser.Events.onMouseMove (Decode.map MouseMove (Decode.field "pageY" Decode.int))
else
Sub.none
]
}