module Main exposing (view)

import Browser
import Browser.Navigation as Nav
import Html exposing (Html, button, div, span, text, img, pre)
import Html.Attributes as H exposing (src, style, width, height)
import Html.Events exposing (onClick)
import Html.Events.Extra.Pointer as Pointer
import Maybe exposing (Maybe)
import Json.Decode as D
import Http
import Point exposing(Point, Pos ,decoder)
import Svg exposing (Svg, svg, rect, circle, g, polyline)
import Svg.Attributes as S exposing
    ( viewBox
    , x, y
    , r, rx, ry
    , cx, cy
    , fill
    , points
    , stroke, strokeWidth, strokeOpacity)
import Url.Parser exposing (Parser, (</>), (<?>), int, map, oneOf, s, string)
import Url.Parser.Query as Query
import Url exposing (Url)


type Route = Timeline (Maybe Int) (Maybe Int)

routeParser : Parser (Route -> a) a
routeParser =
  map Timeline (s "timeline" <?> Query.int "start" <?> Query.int "duration")


-- MAIN


main =
  Browser.application
      { init = init
      , update = update
      , subscriptions = subscriptions
      , onUrlRequest = (\ ur ->  NewUrlRequest)
      , onUrlChange = (\ u -> UrlChanged)
      , view = view }



-- MATHS

-- Coordinates in a Mercator projection
type alias Coord = { x: Float, y: Float }

-- zoom level
type alias Zoom = Int

type alias TileNumber = { x: Int, y: Int }

type alias Lat = Float
type alias Lng = Float

-- project lat/long to co-ordinates based on pseudocode at
-- https://wiki.openstreetmap.org/wiki/Slippy_map_tilenames#Zoom_levels

sec x = 1 / (cos x)

toCoord : Lat -> Lng -> Coord
toCoord lat lng =
    let
        lat_rad = lat * pi / 180
        x = (lng + 180) / 360
        y = (1 - (logBase e ((tan lat_rad) + (sec lat_rad))) / pi) / 2
    in
        Coord x y

pixelsToCoord z (x,y) =
    let x_float = toFloat x / toFloat ( 2 ^ (z + 8))
        y_float = toFloat y / toFloat ( 2 ^ (z + 8))
    in Coord x_float y_float

reflect : Coord -> Coord
reflect c = Coord -c.x -c.y

-- translate : a -> a -> a
translate base offset =
    { base | x = (base.x + offset.x), y = (base.y + offset.y) }

translatePixels : Coord -> Zoom -> (Int, Int) -> Coord
translatePixels old z (x, y) = translate old (pixelsToCoord z (x, y))


tileCovering : Coord -> Zoom -> TileNumber
tileCovering c z =
    TileNumber (truncate (toFloat (2 ^ z) * c.x)) (truncate (toFloat (2 ^ z) * c.y))

pixelFromCoord : Coord -> Zoom -> (Int, Int)
pixelFromCoord c z =
    let {x,y} = tileCovering c (z + 8)
    in (x,y)

boundingTiles : Coord -> Zoom -> Int -> Int -> (TileNumber, TileNumber)
boundingTiles centre z width height =
    -- find the tiles needed to cover the area (`width` x `height`)
    -- about the point at `centre`
    let delta = pixelsToCoord z ((width // 2), (height // 2))
        minCoord = translate centre (reflect delta)
        maxCoord = translate centre delta
    in ((tileCovering minCoord z),
        (translate (tileCovering maxCoord z) (TileNumber 1 1)))

-- MODEL

type Drag
    = None
    | Dragging  (Int, Int)  (Int, Int)

dragTo : Drag ->  (Int, Int) -> Drag
dragTo d dest =
    case d of
        None -> None
        Dragging from to -> Dragging from dest

dragDelta d =
    case d of
        None -> (0,0)
        Dragging (fx,fy) (tx,ty) -> (fx-tx, fy-ty)

type TrackState = Empty | Loading | Failure String | Present (List Point)
type alias Model =
    { centre: Coord
    , zoom: Zoom
    , drag: Drag
    , startTime : Int
    , duration : Int
    , track: TrackState }

init : () -> Url -> Nav.Key -> (Model, Cmd Msg)
init _ url navKey =
    let (start, duration) =
            case Url.Parser.parse routeParser url of
                Just (Timeline (Just s) (Just d)) -> (s, d)
                _ -> (10,10)
    in
        ((Model (toCoord 51.60 -0.01) 13 None start duration Empty),
             (fetchTrack start duration))

-- SUBSCRIPTIONS

subscriptions : Model -> Sub Msg
subscriptions model = Sub.none


fetchTrack start duration = Http.get
        { url = ("http://localhost:3000/points?start=" ++
                     String.fromInt start ++
                     "&duration=" ++
                     String.fromInt duration)
        , expect = Http.expectJson Loaded (D.list Point.decoder)
        }



-- UPDATE

type Msg
  = ZoomIn
  | ZoomOut
  | Scroll Int Int
  | PointerDown (Int, Int)
  | PointerMove (Int, Int)
  | PointerUp (Int, Int)
  | Loaded (Result Http.Error (List Point))
  | NewUrlRequest
  | UrlChanged


update : Msg -> Model -> (Model, Cmd Msg)

update msg model = (newModel msg model, Cmd.none)

newModel msg model =
    case msg of
        ZoomIn ->
            { model | zoom = model.zoom + 1 }

        ZoomOut ->
            { model | zoom = model.zoom - 1 }

        Scroll x y ->
            { model | centre = translatePixels model.centre model.zoom (x,y) }

        PointerDown (x,y) ->
            { model | drag = Dragging (x,y) (x,y) }

        PointerMove (x,y) ->
            { model | drag = dragTo model.drag (x,y) }

        PointerUp (x,y) ->
            { model | drag = None,
                  centre = translatePixels model.centre model.zoom (dragDelta model.drag) }

        Loaded result ->
            case result of
                Ok trk -> { model | track = Present trk }
                Err (Http.BadBody e) -> { model | track = Debug.log e (Failure "e") }
                Err e -> { model | track = Debug.log "unknown error" (Failure "e") }
        NewUrlRequest -> model
        UrlChanged ->  model

-- VIEW

tileUrl : TileNumber -> Zoom -> String
tileUrl {x,y} z =
    String.concat ["https://a.tile.openstreetmap.org",
                       "/", String.fromInt z,
                       "/", String.fromInt x,
                       "/", String.fromInt y,
                       ".png" ]

tileImg zoom tilenumber = img [ width 256,
                                height 256,
                                src (tileUrl tilenumber zoom) ] []


measureView : (Point -> Maybe Float) -> List Point -> Svg Msg
measureView fn allPoints =
    let filteredPoints = Point.downsample 300 allPoints
        startTime = case allPoints of
                        (p::_) -> p.time
                        _ -> 0
        coords p = case (fn p) of
                       Just c ->
                           (String.fromFloat (p.time - startTime)) ++ "," ++
                           (String.fromFloat c) ++ ", "
                       Nothing -> ""
        string = String.concat (List.map coords filteredPoints)
    in
        svg
        [ H.style "width" (px portalWidth)
        , viewBox ("0 0 " ++ (String.fromFloat (Point.duration allPoints)) ++ " 150")
        ]
        [ g
          [ fill "none"
          , stroke "red"
          , strokeWidth "3"
          ]
          [
           polyline
               [ fill "none"
               , S.points string
               ] []
          ]
        ]

cadenceView : List Point -> Svg Msg
cadenceView =
    measureView (.cadence >> Maybe.map toFloat)

powerView = measureView (.power >> Maybe.map toFloat)

eleView =
    measureView (.pos >> .ele)


trackView : Int -> Int -> Zoom -> List Point -> Svg Msg
trackView leftedge topedge zoom points =
    let plot p =
            let (x, y) = pixelFromCoord (toCoord p.pos.lat p.pos.lon) zoom
                x_ = x - leftedge
                y_ = y - topedge
            in (String.fromInt x_) ++ ", " ++
                (String.fromInt y_) ++ ", "
        line = String.concat (List.map plot points)
    in
    svg
    [ H.style "width" "100%"
    , H.style "height" "100%"
    , H.style "position" "absolute"
    ]
    [ g
      [ fill "none"
      , stroke "blue"
      , strokeWidth "7"
      , strokeOpacity "0.5"]
      [
       polyline
       [ fill "none"
       , S.points  line
       ] []
      ]
    ]


px x = String.fromInt x ++ "px"

tiles xs ys zoom =
    List.map
        (\ y -> div []
             (List.map (\ x -> tileImg zoom (TileNumber x y)) xs))
        ys

ifTrack track content =
    case track of
        Present t -> content t
        Failure f -> Debug.log f (div [] [ text "failure", text f])
        Loading -> div [] [text "loading"]
        Empty -> div [] [text "no points"]


canvas centre zoom width height track =
    let (mintile, maxtile) = boundingTiles centre zoom width height
        -- offset is pixel difference between centre (which *should*
        -- be the middle of the image) and actual middle of the canvas
        (pixelCentreX,pixelCentreY) = pixelFromCoord centre zoom
        leftedge = mintile.x * 256
        topedge = mintile.y * 256
        offsetX = pixelCentreX - (width // 2) - leftedge
        offsetY = pixelCentreY - (height // 2) - topedge
        pixWidth = (1 + maxtile.x - mintile.x) * 256
        pixHeight = (1 + maxtile.y - mintile.y) * 256
        xs = List.range mintile.x maxtile.x
        ys = List.range mintile.y maxtile.y
        epos e = Tuple.mapBoth floor floor e.pointer.clientPos
        tv = ifTrack track (trackView leftedge topedge zoom)
    in  div [style "position" "absolute"
            ,style "width" (px pixWidth)
            ,style "height" (px pixHeight)
            ,style "left" (px -offsetX)
            ,style "top" (px -offsetY)
            ,style "lineHeight" (px 0)
            ,Pointer.onUp (\e -> PointerUp (epos e))
            ,Pointer.onMove (\e -> PointerMove (epos e))
            ,Pointer.onDown (\e -> PointerDown (epos e)) ]
        (tv :: tiles xs ys zoom)

portalWidth = 600
portalHeight = 600

viewDiv : Model -> Html Msg
viewDiv model =
    let coord = translate model.centre (pixelsToCoord model.zoom (dragDelta model.drag))
        canvasV = canvas coord model.zoom portalWidth portalHeight model.track
    in div [ style "display" "flex" ]
        [ div [ style "display" "flex"
              , style "flex-direction" "column"]
              [ div [ style "width" (px portalWidth)
                    , style "height" (px portalHeight)
                    , style "display" "inline-block"
                    , style "position" "relative"
                    , style "overflow" "hidden"]
                    [canvasV]
              , text ("Zoom level " ++ (String.fromInt model.zoom))
              , span []
                  [ button [ onClick ZoomOut ] [ text "-" ]
                  , button [ onClick ZoomIn ] [ text "+" ]
                  , button [ onClick (Scroll 0 -10) ] [ text "^" ]
                  , button [ onClick (Scroll 0 10) ] [ text "V" ]
                  , button [ onClick (Scroll -10 0) ] [ text "<" ]
                  , button [ onClick (Scroll 10 0) ] [ text ">" ]
                  ]
              ]
        , div [ style "display" "flex"
              , style "flex-direction" "column"]
            [ div [] [ ifTrack model.track cadenceView ]
            , div [] [ ifTrack model.track powerView ]
            , div [] [ ifTrack model.track eleView ]
            ]
        ]

view : Model -> Browser.Document Msg
view model =
    Browser.Document  "Souplesse elm" [  (viewDiv model) ]