From 25afb0bde9b8a2c064135a534231c232a461b341 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 16 Feb 2020 22:45:07 +0100
Subject: Set up a first version of tabata timer

---
 src/Dom/Document.ml    |   4 ++
 src/Dom/Element.ml     |  14 ++++++
 src/Dom/Event.ml       |   3 ++
 src/Dom/EventTarget.ml |   1 +
 src/animation.ml       |  26 +++++++++++
 src/arc.ml             |  23 ++++++++++
 src/audio.ml           |  13 ++++++
 src/config.ml          |  96 ++++++++++++++++++++++++++++++++++++++++
 src/duration.ml        |   6 +++
 src/main.ml            |  18 ++++++++
 src/option.ml          |   1 +
 src/step.ml            |  40 +++++++++++++++++
 src/string.ml          |   1 +
 src/timer.ml           | 116 +++++++++++++++++++++++++++++++++++++++++++++++++
 14 files changed, 362 insertions(+)
 create mode 100644 src/Dom/Document.ml
 create mode 100644 src/Dom/Element.ml
 create mode 100644 src/Dom/Event.ml
 create mode 100644 src/Dom/EventTarget.ml
 create mode 100644 src/animation.ml
 create mode 100644 src/arc.ml
 create mode 100644 src/audio.ml
 create mode 100644 src/config.ml
 create mode 100644 src/duration.ml
 create mode 100644 src/main.ml
 create mode 100644 src/option.ml
 create mode 100644 src/step.ml
 create mode 100644 src/string.ml
 create mode 100644 src/timer.ml

(limited to 'src')

diff --git a/src/Dom/Document.ml b/src/Dom/Document.ml
new file mode 100644
index 0000000..afd1a84
--- /dev/null
+++ b/src/Dom/Document.ml
@@ -0,0 +1,4 @@
+external querySelector : string -> Dom.element option = "querySelector"
+  [@@bs.val] [@@bs.scope "document"]
+
+let querySelectorUnsafe id = querySelector id |> Js.Option.getExn
diff --git a/src/Dom/Element.ml b/src/Dom/Element.ml
new file mode 100644
index 0000000..4b38fa9
--- /dev/null
+++ b/src/Dom/Element.ml
@@ -0,0 +1,14 @@
+external setValue : Dom.element -> string -> unit = "value" [@@bs.set]
+
+external setInnerText : Dom.element -> string -> unit = "innerText" [@@bs.set]
+
+external setStyle : Dom.element -> string -> unit = "style" [@@bs.set]
+
+external setClassName : Dom.element -> string -> unit = "className" [@@bs.set]
+
+external setAttribute : Dom.element -> string -> string -> unit = "setAttribute"
+  [@@bs.send]
+
+external addEventListener : Dom.element -> string -> (Dom.event -> unit) -> unit
+  = "addEventListener"
+  [@@bs.send]
diff --git a/src/Dom/Event.ml b/src/Dom/Event.ml
new file mode 100644
index 0000000..bffd242
--- /dev/null
+++ b/src/Dom/Event.ml
@@ -0,0 +1,3 @@
+external preventDefault : Dom.event -> unit = "preventDefault" [@@bs.send]
+
+external target : Dom.event -> Dom.eventTarget = "target" [@@bs.get]
diff --git a/src/Dom/EventTarget.ml b/src/Dom/EventTarget.ml
new file mode 100644
index 0000000..946a518
--- /dev/null
+++ b/src/Dom/EventTarget.ml
@@ -0,0 +1 @@
+external value : Dom.eventTarget -> string option = "value" [@@bs.get]
diff --git a/src/animation.ml b/src/animation.ml
new file mode 100644
index 0000000..7a598e5
--- /dev/null
+++ b/src/animation.ml
@@ -0,0 +1,26 @@
+let mainElt = Document.querySelectorUnsafe "#g-Layout__Main"
+
+let isRunning = ref false
+
+let start ~onHidden ~onEnded =
+  if not !isRunning then
+    let () = isRunning := true in
+    let () = Element.setClassName mainElt "g-Layout__HideMain" in
+    let delay = 200 in
+    let _ =
+      Js.Global.setTimeout
+        (fun () ->
+          let () = onHidden () in
+          let () = Element.setClassName mainElt "" in
+          let _ =
+            Js.Global.setTimeout
+              (fun () ->
+                let () = onEnded () in
+                isRunning := false)
+              delay
+          in
+          ())
+        delay
+    in
+    ()
+  else ()
diff --git a/src/arc.ml b/src/arc.ml
new file mode 100644
index 0000000..7a3195d
--- /dev/null
+++ b/src/arc.ml
@@ -0,0 +1,23 @@
+let polarToCartesian centerX centerY radius angleInDegrees =
+  let angleInRadians = (angleInDegrees -. 90.0) *. Js.Math._PI /. 180.0 in
+  ( centerX +. (radius *. Js.Math.cos angleInRadians),
+    centerY +. (radius *. Js.Math.sin angleInRadians) )
+
+let describe x y radius startAngle endAngle =
+  let startX, startY = polarToCartesian x y radius endAngle in
+  let endX, endY = polarToCartesian x y radius startAngle in
+  let largeArcFlag = if endAngle -. startAngle <= 180.0 then "0" else "1" in
+  [|
+    "M";
+    Js.Float.toString startX;
+    Js.Float.toString startY;
+    "A";
+    Js.Float.toString radius;
+    Js.Float.toString radius;
+    "0";
+    largeArcFlag;
+    "0";
+    Js.Float.toString endX;
+    Js.Float.toString endY;
+  |]
+  |> Js.Array.joinWith " "
diff --git a/src/audio.ml b/src/audio.ml
new file mode 100644
index 0000000..f7358a7
--- /dev/null
+++ b/src/audio.ml
@@ -0,0 +1,13 @@
+type audio
+
+external create : string -> audio = "Audio" [@@bs.new]
+
+external play : audio -> unit = "play" [@@bs.send]
+
+external currentTime : audio -> int = "currentTime" [@@bs.get]
+
+external setCurrentTime : audio -> int -> unit = "currentTime" [@@bs.set]
+
+let playOrReplay audio =
+  let () = if currentTime audio > 0 then setCurrentTime audio 0 else () in
+  play audio
diff --git a/src/config.ml b/src/config.ml
new file mode 100644
index 0000000..cc98c38
--- /dev/null
+++ b/src/config.ml
@@ -0,0 +1,96 @@
+(* Model *)
+
+type config = {
+  prepare : int;
+  tabatas : int;
+  cycles : int;
+  work : int;
+  rest : int;
+}
+
+(* State *)
+
+(* let config = ref { prepare = 10; tabatas = 4; cycles = 8; work = 20; rest = 10 } *)
+
+let config = ref { prepare = 5; tabatas = 4; cycles = 8; work = 20; rest = 10 }
+
+let onStart : (unit -> unit) ref = ref (fun () -> ())
+
+(* Elements *)
+
+let formElt = Document.querySelectorUnsafe "#g-Form"
+
+let prepareElt = Document.querySelectorUnsafe "#g-Form__Prepare"
+
+let tabatasElt = Document.querySelectorUnsafe "#g-Form__Tabatas"
+
+let cyclesElt = Document.querySelectorUnsafe "#g-Form__Cycles"
+
+let workElt = Document.querySelectorUnsafe "#g-Form__Work"
+
+let restElt = Document.querySelectorUnsafe "#g-Form__Rest"
+
+let durationElt = Document.querySelectorUnsafe "#g-Form__DurationValue"
+
+(* Duration *)
+
+let getDuration () =
+  let { prepare; tabatas; cycles; work; rest } = !config in
+  tabatas * (prepare + (cycles * (work + rest)))
+
+let writeDuration () =
+  let duration = getDuration () in
+  Element.setInnerText durationElt (Duration.prettyPrint duration)
+
+(* Write to DOM *)
+
+let writeToDom () =
+  let () = Element.setValue prepareElt (Js.Int.toString !config.prepare) in
+  let () = Element.setValue tabatasElt (Js.Int.toString !config.tabatas) in
+  let () = Element.setValue cyclesElt (Js.Int.toString !config.cycles) in
+  let () = Element.setValue workElt (Js.Int.toString !config.work) in
+  let () = Element.setValue restElt (Js.Int.toString !config.rest) in
+  writeDuration ()
+
+(* Update from DOM *)
+
+let listenTo inputElt update =
+  Element.addEventListener inputElt "input" (fun e ->
+      match
+        EventTarget.value (Event.target e) |> Option.flatMap Belt.Int.fromString
+      with
+      | Some n ->
+          let () = config := update !config n in
+          writeDuration ()
+      | None -> ())
+
+let listenToChanges () =
+  let () = listenTo prepareElt (fun config n -> { config with prepare = n }) in
+  let () = listenTo tabatasElt (fun config n -> { config with tabatas = n }) in
+  let () = listenTo cyclesElt (fun config n -> { config with cycles = n }) in
+  let () = listenTo workElt (fun config n -> { config with work = n }) in
+  listenTo restElt (fun config n -> { config with rest = n })
+
+(* Setup *)
+
+let setup onTimerStart =
+  let () = onStart := onTimerStart in
+  let () = writeToDom () in
+  listenToChanges ()
+
+(* Start *)
+
+let startTimer () =
+  let () = Element.setStyle formElt "display: none" in
+  !onStart ()
+
+(* Hide / show *)
+
+let show () = Element.setStyle formElt "display: flex"
+
+let hide () = Element.setStyle formElt "display: none"
+
+let () =
+  Element.addEventListener formElt "submit" (fun e ->
+      let () = Event.preventDefault e in
+      !onStart ())
diff --git a/src/duration.ml b/src/duration.ml
new file mode 100644
index 0000000..b0b119b
--- /dev/null
+++ b/src/duration.ml
@@ -0,0 +1,6 @@
+let prettyPrintNumber number = String.padStart (Js.Int.toString number) 2 "0"
+
+let prettyPrint duration =
+  let minutes = duration / 60 in
+  let seconds = duration mod 60 in
+  prettyPrintNumber minutes ^ ":" ^ prettyPrintNumber seconds
diff --git a/src/main.ml b/src/main.ml
new file mode 100644
index 0000000..e399e3b
--- /dev/null
+++ b/src/main.ml
@@ -0,0 +1,18 @@
+let onTimerStart () =
+  Animation.start
+    ~onHidden:(fun () ->
+      let () = Config.hide () in
+      let () = Timer.init () in
+      Timer.show ())
+    ~onEnded:Timer.start
+
+let onTimerStop () =
+  Animation.start
+    ~onHidden:(fun () ->
+      let () = Timer.hide () in
+      Config.show ())
+    ~onEnded:(fun () -> ())
+
+let () =
+  let () = Config.setup onTimerStart in
+  Timer.setup onTimerStop
diff --git a/src/option.ml b/src/option.ml
new file mode 100644
index 0000000..16047fd
--- /dev/null
+++ b/src/option.ml
@@ -0,0 +1 @@
+let flatMap f opt = Belt.Option.flatMapU opt (fun [@bs] x -> f x)
diff --git a/src/step.ml b/src/step.ml
new file mode 100644
index 0000000..02a110e
--- /dev/null
+++ b/src/step.ml
@@ -0,0 +1,40 @@
+type step = Prepare | Work | Rest | End
+
+let prettyPrint step =
+  match step with
+  | Prepare -> "Prepare"
+  | Work -> "Work"
+  | Rest -> "Rest"
+  | End -> "End"
+
+type state = { step : step; remaining : int; tabata : int; cycle : int }
+
+let getAt (config : Config.config) elapsed =
+  let cycleDuration = config.work + config.rest in
+  let tabataDuration = config.prepare + (config.cycles * cycleDuration) in
+  if elapsed >= tabataDuration * config.tabatas then
+    {
+      step = End;
+      remaining = 0;
+      tabata = config.tabatas;
+      cycle = config.cycles;
+    }
+  else
+    let currentTabataElapsed = elapsed mod tabataDuration in
+    let step, remaining =
+      if currentTabataElapsed < config.prepare then
+        (Prepare, config.prepare - currentTabataElapsed)
+      else
+        let currentCycleElapsed =
+          (currentTabataElapsed - config.prepare) mod cycleDuration
+        in
+        if currentCycleElapsed < config.work then
+          (Work, config.work - currentCycleElapsed)
+        else (Rest, config.work + config.rest - currentCycleElapsed)
+    in
+    let tabata = (elapsed / tabataDuration) + 1 in
+    let cycle =
+      if currentTabataElapsed < config.prepare then 1
+      else ((currentTabataElapsed - config.prepare) / cycleDuration) + 1
+    in
+    { step; remaining; tabata; cycle }
diff --git a/src/string.ml b/src/string.ml
new file mode 100644
index 0000000..335fdec
--- /dev/null
+++ b/src/string.ml
@@ -0,0 +1 @@
+external padStart : string -> int -> string -> string = "padStart" [@@bs.send]
diff --git a/src/timer.ml b/src/timer.ml
new file mode 100644
index 0000000..5ff0b8b
--- /dev/null
+++ b/src/timer.ml
@@ -0,0 +1,116 @@
+(* Audio *)
+
+let c3 = Audio.create "sounds/c3.mp3"
+
+let c4 = Audio.create "sounds/c4.mp3"
+
+let c5 = Audio.create "sounds/c5.mp3"
+
+let playAudio (step : Step.state) =
+  match step.step with
+  | Step.Prepare when step.remaining == !Config.config.prepare ->
+      Audio.playOrReplay c3
+  | Step.Work when step.remaining == !Config.config.work ->
+      Audio.playOrReplay c5
+  | Step.Rest when step.remaining == !Config.config.rest ->
+      Audio.playOrReplay c3
+  | Step.End -> Audio.playOrReplay c3
+  | _ -> if step.remaining <= 3 then Audio.playOrReplay c4 else ()
+
+(* Elements *)
+
+let timerElt = Document.querySelectorUnsafe "#g-Timer"
+
+let dialElt = Document.querySelectorUnsafe "#g-Timer__Dial"
+
+let arcPathElt = Document.querySelectorUnsafe "#g-Timer__ArcProgress"
+
+let stepElt = Document.querySelectorUnsafe "#g-Timer__Step"
+
+let durationElt = Document.querySelectorUnsafe "#g-Timer__Duration"
+
+let tabataCurrentElt = Document.querySelectorUnsafe "#g-Timer__TabataCurrent"
+
+let tabataTotalElt = Document.querySelectorUnsafe "#g-Timer__TabataTotal"
+
+let cycleCurrentElt = Document.querySelectorUnsafe "#g-Timer__CycleCurrent"
+
+let cycleTotalElt = Document.querySelectorUnsafe "#g-Timer__CycleTotal"
+
+let stopElt = Document.querySelectorUnsafe "#g-Timer__Stop"
+
+(* State *)
+
+let interval = ref None
+
+let duration = ref 0
+
+let elapsedTime = ref 0
+
+let onStop : (unit -> unit) ref = ref (fun () -> ())
+
+let isPlaying = ref false
+
+(* Actions *)
+
+let playPause _ = isPlaying := not !isPlaying
+
+let stop _ =
+  let () = Belt.Option.forEach !interval Js.Global.clearInterval in
+  !onStop ()
+
+(* View *)
+
+let updateDom () =
+  let angle =
+    Js.Int.toFloat !elapsedTime /. Js.Int.toFloat !duration *. 360.0
+  in
+  let () =
+    Element.setAttribute arcPathElt "d" (Arc.describe 0.0 0.0 95.0 0.0 angle)
+  in
+  let step = Step.getAt !Config.config !elapsedTime in
+  let () = Element.setInnerText stepElt (Step.prettyPrint step.step) in
+  let () =
+    Element.setInnerText durationElt (Duration.prettyPrint step.remaining)
+  in
+  let () =
+    Element.setInnerText tabataCurrentElt (Js.Int.toString step.tabata)
+  in
+  let () = playAudio step in
+  Element.setInnerText cycleCurrentElt (Js.Int.toString step.cycle)
+
+(* Update *)
+
+let update () =
+  if !isPlaying then
+    let () = elapsedTime := !elapsedTime + 1 in
+    if !elapsedTime > !duration then stop () else updateDom ()
+  else ()
+
+(* Init *)
+
+let init () =
+  let () = duration := Config.getDuration () in
+  let () = elapsedTime := 0 in
+  let () =
+    Element.setInnerText tabataTotalElt (Js.Int.toString !Config.config.tabatas)
+  in
+  Element.setInnerText cycleTotalElt (Js.Int.toString !Config.config.cycles)
+
+(* Setup and start *)
+
+let setup onTimerStop = onStop := onTimerStop
+
+let show () =
+  let () = updateDom () in
+  Element.setStyle timerElt "display: flex"
+
+let hide () = Element.setStyle timerElt "display: none"
+
+let start () =
+  let () = interval := Some (Js.Global.setInterval update 1000) in
+  isPlaying := true
+
+let () =
+  let () = Element.addEventListener stopElt "click" stop in
+  Element.addEventListener dialElt "click" playPause
-- 
cgit v1.2.3