~singpolyma/post-part

ref: fa0c8bd1a7b10c421c9032a2af9d20058ff9627c post-part/Interactive.purs -rw-r--r-- 5.9 KiB
fa0c8bd1Stephen Paul Weber 'change link' 6 months ago
                                                                                
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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
-- Full source may be found at: https://git.singpolyma.net/post-part
-- Copyright 2020 Stephen Paul Weber <singpolyma.net>
--
-- Permission to use, copy, modify, and/or distribute this software for any
-- purpose with or without fee is hereby granted, provided that the above
-- copyright notice and this permission notice appear in all copies.
--
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-- SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER
-- RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
-- CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
-- CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

module Interactive where

import Prelude
import Effect
import Effect.Class
import Data.Maybe
import Data.Either
import Data.Array
import Debug.Trace
import Data.Traversable
import Math as Math
import Data.Tuple (Tuple(..))
import Data.Int as Int
import Effect.Timer as Timer
import Effect.Ref as Ref
import Effect.Aff (Aff, Canceler(..), makeAff, launchAff_)
import Web.DOM.ParentNode (querySelector, querySelectorAll, QuerySelector(..), ParentNode)
import Web.DOM.Document as DOMDocument
import Web.HTML.HTMLDocument as HTMLDocument
import Web.HTML.HTMLElement as HTMLElement
import Web.HTML.HTMLMediaElement as HTMLMediaElement
import Web.HTML (window, HTMLElement, HTMLMediaElement)
import Web.HTML.Event.EventTypes (load)
import Web.UIEvent.MouseEvent as MouseEvent
import Web.UIEvent.MouseEvent.EventTypes (mousemove, mouseout, click)
import Web.HTML.Window as Window
import Web.DOM.Element as Element
import Web.DOM.NodeList as NodeList
import Web.DOM.DOMTokenList as DOMTokenList
import Web.Event.EventTarget (addEventListener, eventListener)
import Partial.Unsafe (unsafePartial)
import Web.CSSOM.ElementCSSInlineStyle as Style
import Web.CSSOM.CSSStyleDeclaration as Style

addEventListener' eventType eventTarget cb = do
  listener <- eventListener cb
  addEventListener eventType listener false eventTarget

clipCircle el size x y = do
  style <- Style.style $ Style.fromHTMLElement el
  Style.setProperty style "-webkit-clip-path" ("circle(" <> size <> " at " <> (show x) <> "px " <> (show y) <> "px)")
  Style.setProperty style "clip-path" ("circle(" <> size <> " at " <> (show x) <> "px " <> (show y) <> "px)")

getFigures :: ParentNode -> Effect (Array (Tuple HTMLElement HTMLMediaElement))
getFigures parent = do
  figNodes <- NodeList.toArray =<< querySelectorAll (QuerySelector "figure") parent
  let figEls = mapMaybe HTMLElement.fromNode figNodes
  audios <- catMaybes <$> traverse (\figure ->
      (HTMLMediaElement.fromElement =<< _) <$> querySelector (QuerySelector $ "audio") (HTMLElement.toParentNode figure)
    ) figEls
  pure $ zip figEls audios

fadeVolume :: Number -> Number -> HTMLMediaElement -> Aff Unit
fadeVolume from to media =
  makeAff $ \callback -> do
    HTMLMediaElement.setVolume from media
    tickRef <- Ref.new 1
    intervalID <- Ref.new Nothing
    (flip Ref.write intervalID =<< _) $ map Just $ Timer.setInterval 10 $ do
      tick <- Ref.read tickRef
      HTMLMediaElement.setVolume (from + swing (Int.toNumber tick / Int.toNumber ticks) * delta) media
      tick <- Ref.modify (_ + 1) tickRef
      when (tick == ticks) $ do
        HTMLMediaElement.setVolume to media
        traverse_ Timer.clearInterval =<< Ref.read intervalID
        callback (Right unit)
    pure $ Canceler $ const $ liftEffect $
      traverse_ Timer.clearInterval =<< Ref.read intervalID
  where
  delta = to - from
  ticks = 100
  swing p = 0.5 - Math.cos (p * Math.pi) / 2.0

triggerSpot :: ParentNode -> Maybe Int -> Effect Unit
triggerSpot doc n = do
  figures <- getFigures doc
  traverse_ (\(Tuple i (Tuple figure audio)) -> do
    style <- Style.style (Style.fromHTMLElement figure)
    paused <- HTMLMediaElement.paused audio
    if Just i == n then do
      Style.setProperty style "opacity" "1"
      when paused $ do
        launchAff_ $ fadeVolume 0.0 1.0 audio
        HTMLMediaElement.play audio
    else do
      Style.setProperty style "opacity" "0"
      when (not paused) $ launchAff_ $ do
        fadeVolume 1.0 0.0 audio
        liftEffect $ HTMLMediaElement.load audio
  ) (zip (1..5) figures)

triggerN width height x y =
  case Tuple across down of
    (Tuple 0 0) -> Just 1
    (Tuple 1 0) -> Just 2
    (Tuple 0 1) -> Just 3
    (Tuple 1 1) -> Just 4
    (Tuple 0 2) -> Just 5
    _           -> Nothing
  where
  across = Int.floor ((Int.toNumber x) * 2.0 / width)
  down = Int.floor ((Int.toNumber y) * 3.0 / height)

main = unsafePartial $ do
  win <- window
  doc <- HTMLDocument.toParentNode <$> Window.document win
  addEventListener' load (Window.toEventTarget win) $ \_ -> do
    Just body <- querySelector (QuerySelector "body") doc
    Just wallpaper <- querySelector (QuerySelector "#wallpaper") doc
    Just bgmusic <- (HTMLMediaElement.fromElement =<< _) <$> querySelector (QuerySelector "#bgmusic") doc

    Just img <- (HTMLElement.fromElement =<< _) <$>
      querySelector (QuerySelector "#wallpaper > img") doc

    (flip DOMTokenList.add "js") =<< Element.classList wallpaper
    clipCircle img "0" 0 0

    addEventListener' mouseout (Element.toEventTarget wallpaper) $ \_ -> do
      clipCircle img "0" 0 0
      triggerSpot doc Nothing

    addEventListener' click (Element.toEventTarget body) $ \_ -> do
      paused <- HTMLMediaElement.paused bgmusic
      when paused $ HTMLMediaElement.play bgmusic
      addEventListener' mousemove (Element.toEventTarget wallpaper) $ \e -> do
        height <- Element.clientHeight wallpaper
        width <- Element.clientWidth wallpaper
        let Just mouseEvent = MouseEvent.fromEvent e
        clipCircle img "10vw" (MouseEvent.offsetX mouseEvent) (MouseEvent.offsetY mouseEvent)
        triggerSpot doc (triggerN width height (MouseEvent.offsetX mouseEvent) (MouseEvent.offsetY mouseEvent))