Advertisement
Guest User

Untitled

a guest
May 29th, 2016
45
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.26 KB | None | 0 0
  1. import Html exposing (..)
  2. import Html.Attributes exposing (..)
  3. import Html.App as Html
  4. import Html.Events exposing (onMouseDown, onMouseUp)
  5. import Mouse exposing (..)
  6.  
  7.  
  8. main =
  9. Html.program
  10. { init = init
  11. , view = view
  12. , update = update
  13. , subscriptions = subscriptions
  14. }
  15.  
  16.  
  17.  
  18. -- MODEL
  19.  
  20.  
  21. type alias Model =
  22. { x: Int
  23. , y : Int
  24. , mouseDown: MouseDown
  25. }
  26.  
  27. init : (Model, Cmd Msg)
  28. init =
  29. ({ x = 0, y = 0, mouseDown = No}, Cmd.none)
  30.  
  31.  
  32. -- UPDATE
  33.  
  34. type MouseDown
  35. = Yes
  36. | No
  37.  
  38.  
  39. type Msg
  40. = Position Int Int
  41. | Down MouseDown
  42.  
  43.  
  44. update : Msg -> Model -> (Model, Cmd Msg)
  45. update msg model =
  46. case msg of
  47. Position x y ->
  48. ({model | x = x, y = y}, Cmd.none)
  49. Down isit ->
  50. ({model | mouseDown = isit}, Cmd.none)
  51.  
  52.  
  53. -- SUBSCRIPTIONS
  54.  
  55.  
  56. subscriptions : Model -> Sub Msg
  57. subscriptions model =
  58. case model.mouseDown of
  59. Yes ->
  60. Mouse.moves (\{x, y} -> Position x y)
  61. No ->
  62. Sub.none
  63.  
  64. -- VIEW
  65.  
  66.  
  67. view : Model -> Html Msg
  68. view model =
  69. let
  70. x = model.x |> toString
  71. y = model.y |> toString
  72. in
  73. div
  74. [ onMouseDown (Down Yes)
  75. , onMouseUp (Down No)
  76. , style
  77. [ ("width", "300px")
  78. , ("height", "300px")
  79. , ("border", "1px solid black")
  80. ]
  81. ]
  82. [ p []
  83. [text (x ++ ", " ++ y)]
  84. ]
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement