summaryrefslogtreecommitdiff
path: root/elm/Lightbox.elm
blob: 6851cfac71171a034c03e9939a84baabd710f883 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
port module Lightbox exposing (main)

-- TODO: Display release info below the image
-- TODO: Display quick-select thumbnails below the image if there's enough room?

import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Platform.Cmd
import Platform.Sub
import Window
import Array
import Task
import Keyboard exposing (..)
import Json.Decode exposing (succeed)

main : Program Model Model Msg
main = Html.programWithFlags
  { init   = \m -> (m, Cmd.batch [setPreload m, Task.perform Resize Window.size])
  , view   = view
  , update = update
  , subscriptions = always <| Sub.batch [Window.resizes Resize, preloaded Preloaded, downs Keydown]
  }

port close : Bool -> Cmd msg
port preload : String -> Cmd msg
port preloaded : (String -> msg) -> Sub msg

type alias Image =
  { thumb  : String
  , full   : String
  , width  : Int
  , height : Int
  , load   : Bool
  }

type alias Model =
  { images  : Array.Array Image
  , current : Int
  , width   : Int
  , height  : Int
  }

type Msg
  = Next
  | Prev
  | Close
  | Resize Window.Size
  | Preloaded String
  | Keydown KeyCode


setPreload : Model -> Cmd Msg
setPreload model =
  let cmd n =
    case Array.get (model.current+n) model.images of
      Nothing -> Cmd.none
      Just i -> if i.load then Cmd.none else preload i.full
  in if cmd 0 /= Cmd.none then cmd 0 else Cmd.batch [cmd -1, cmd 1]


update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
  let move n = 
    case Array.get (model.current+n) model.images of
      Nothing -> model ![]
      Just i -> let m = { model | current = model.current+n } in (m, setPreload m)
  in
  case msg of
    Next       -> move 1
    Prev       -> move -1
    Close      -> (model, close True)
    Keydown 27 -> (model, close True)
    Keydown 37 -> move -1
    Keydown 39 -> move 1
    Keydown _  -> model![]
    Resize size -> { model | width = size.width, height = size.height } ![]
    Preloaded url ->
      let m = { model | images = Array.map (\img -> if img.full == url then { img | load = True } else img) model.images }
      in (m, setPreload m)


view : Model -> Html Msg
view model =
  let
    -- 'onClick' with stopPropagation
    onClickN action = onWithOptions "click" { stopPropagation = True, preventDefault = True } (succeed action)

    -- Maximum image dimensions
    awidth  = toFloat model.width * 0.84
    aheight = toFloat model.height - 80

    full_img action position i =
      -- Scale image down to fit inside awidth/aheight
      let swidth  = awidth  / toFloat i.width
          sheight = aheight / toFloat i.height
          scale   = Basics.min 1 <| if swidth < sheight then swidth else sheight
          iwidth  = round <| scale * toFloat i.width
          iheight = round <| scale * toFloat i.height
          cwidth  = ("width",  toString iwidth  ++ "px")
          cheight = ("height", toString iheight ++ "px")
          imgsrc  = if i.load then i.full else i.thumb
      in
      a [ href "javascript:;", onClickN action, style [ cheight ]
        , class <| "lightbox__image lightbox__image-" ++ position ]
        [ img [ class "lightbox__img", src imgsrc, style [ cwidth, cheight ] ] [] ]

    full offset action position =
      case Array.get (model.current + offset) model.images of
        Nothing -> text ""
        Just i -> full_img action position i
  in
  div [ class "lightbox", onClick Close ]
    [ a [ href "javascript:;", onClickN Close, class "lightbox__close" ] []
    , full -1 Prev  "left"
    , full  0 Close "current"
    , full  1 Next  "right"
    ]