aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Dom/Document.ml4
-rw-r--r--src/Dom/Element.ml14
-rw-r--r--src/Dom/Event.ml3
-rw-r--r--src/Dom/EventTarget.ml1
-rw-r--r--src/animation.ml26
-rw-r--r--src/arc.ml23
-rw-r--r--src/audio.ml13
-rw-r--r--src/config.ml96
-rw-r--r--src/duration.ml6
-rw-r--r--src/main.ml18
-rw-r--r--src/option.ml1
-rw-r--r--src/step.ml40
-rw-r--r--src/string.ml1
-rw-r--r--src/timer.ml116
14 files changed, 362 insertions, 0 deletions
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 00:17:32 +0000