From 071b07463ab3f6894928b13553e98cd47c9ccb18 Mon Sep 17 00:00:00 2001
From: Joris
Date: Tue, 28 Jun 2016 00:32:37 +0200
Subject: Add tooltips

---
 src/client/elm/Tooltip.elm | 113 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 113 insertions(+)
 create mode 100644 src/client/elm/Tooltip.elm

(limited to 'src/client/elm/Tooltip.elm')

diff --git a/src/client/elm/Tooltip.elm b/src/client/elm/Tooltip.elm
new file mode 100644
index 0000000..4f70cda
--- /dev/null
+++ b/src/client/elm/Tooltip.elm
@@ -0,0 +1,113 @@
+module Tooltip exposing
+  ( Msg(..)
+  , Model
+  , init
+  , subscription
+  , update
+  , view
+  , show
+  )
+
+import Platform.Cmd
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+
+import Mouse exposing (Position)
+import Window exposing (Size)
+
+type Msg =
+  UpdateMousePosition Position
+  | UpdateWindowSize Size
+  | ShowMessage String
+  | HideMessage
+
+type alias Model =
+  { mousePosition : Maybe Position
+  , windowSize : Size
+  , message : Maybe String
+  }
+
+init : Int -> Int -> Model
+init width height =
+  { mousePosition = Nothing
+  , windowSize =
+      { width = width
+      , height = height
+      }
+  , message = Nothing
+  }
+
+subscription : Sub Msg
+subscription =
+  Sub.batch
+    [ Mouse.moves UpdateMousePosition
+    , Window.resizes UpdateWindowSize
+    ]
+
+update : Msg -> Model -> (Model, Cmd Msg)
+update msg model =
+  case msg of
+    UpdateMousePosition position ->
+      ( { model | mousePosition = Just position }
+      , Cmd.none
+      )
+
+    UpdateWindowSize size ->
+      ( { model | windowSize = size }
+      , Cmd.none
+      )
+
+    ShowMessage message ->
+      ( { model | message = Just message }
+      , Cmd.none
+      )
+
+    HideMessage ->
+      ( { model | message = Nothing }
+      , Cmd.none
+      )
+
+view : Model -> Html Msg
+view { mousePosition, windowSize, message } =
+  case (mousePosition, message) of
+    (Just pos, Just msg) ->
+      div
+        [ class "tooltip"
+        , style
+            [ ("position", "absolute")
+            , horizontalPosition windowSize pos
+            , ("top", px <| pos.y + 15)
+            ]
+        ]
+        [ text msg ]
+    _ ->
+      text ""
+
+horizontalPosition : Size -> Position -> (String, String)
+horizontalPosition size position =
+  if isLeft size position
+    then ("left", px <| position.x + 5)
+    else ("right", px <| size.width - position.x)
+
+verticalPosition : Size -> Position -> (String, String)
+verticalPosition size position =
+  if isTop size position
+    then ("top", px <| position.y + 20)
+    else ("bottom", px <| size.height - position.y + 15)
+
+px : Int -> String
+px n = (toString n) ++ "px"
+
+isLeft : Size -> Position -> Bool
+isLeft { width } { x } = x < width // 2
+
+isTop : Size -> Position -> Bool
+isTop { height } { y } = y < height // 2
+
+show : (Msg -> msg) -> String -> List (Attribute msg)
+show mapMsg message =
+  [ onMouseEnter <| mapMsg <| ShowMessage message
+  , onMouseLeave <| mapMsg <| HideMessage
+  ]
-- 
cgit v1.2.3