A Nix-friendly SQLite-enhanced fork of Flitter, a speedrunning split timer for Unix-style terminals
Revision | 3247aeb375ae5c49ecaf6ff00059a8b5a96412ce (tree) |
---|---|
Time | 2022-12-19 09:45:40 |
Author | Corbin <cds@corb...> |
Commiter | Corbin |
Set up and invoke ocamlformat.
This was less than I expected! ocamlformat has improved greatly.
@@ -0,0 +1,12 @@ | ||
1 | +{ nixpkgs ? import <nixpkgs> {} }: | |
2 | +let | |
3 | + inherit (nixpkgs) pkgs; | |
4 | +in pkgs.stdenv.mkDerivation { | |
5 | + name = "flitter-dev-env"; | |
6 | + buildInputs = with pkgs; [ | |
7 | + # working with S-expressions | |
8 | + ocamlPackages.sexp | |
9 | + # maintaining OCaml code | |
10 | + ocamlformat | |
11 | + ]; | |
12 | +} |
@@ -2,15 +2,17 @@ open Core | ||
2 | 2 | open Notty |
3 | 3 | |
4 | 4 | let big_font_map = |
5 | - let font = [ | |
6 | - "00000111112222233333444445555566666777778888899999 !!::.."; | |
7 | - ".^^. .| .^^. .^^. . | |^^^ .^^ ^^^| .^^. .^^. | "; | |
8 | - "| | | .^ .^ |..| |.. |.. ][ ^..^ ^..| | ^ "; | |
9 | - "| | | .^ . | | | | | | | | | ^ ^ "; | |
10 | - " ^^ ^^^ ^^^^ ^^ ^ ^^^ ^^ ^ ^^ ^^ ^ ^ "; | |
11 | - ] in | |
12 | - | |
13 | - let uchar_of_char = | |
5 | + let font = | |
6 | + [ | |
7 | + "00000111112222233333444445555566666777778888899999 !!::.."; | |
8 | + ".^^. .| .^^. .^^. . | |^^^ .^^ ^^^| .^^. .^^. | "; | |
9 | + "| | | .^ .^ |..| |.. |.. ][ ^..^ ^..| | ^ "; | |
10 | + "| | | .^ . | | | | | | | | | ^ ^ "; | |
11 | + " ^^ ^^^ ^^^^ ^^ ^ ^^^ ^^ ^ ^^ ^^ ^ ^ "; | |
12 | + ] | |
13 | + in | |
14 | + | |
15 | + let uchar_of_char = | |
14 | 16 | let open Caml.Uchar in |
15 | 17 | function |
16 | 18 | | '[' -> of_int 0x258C |
@@ -25,18 +27,20 @@ let big_font_map = | ||
25 | 27 | |
26 | 28 | let extract_char_at start_idx = |
27 | 29 | let ch = String.get fst_line start_idx in |
28 | - let end_idx = (String.rindex_exn fst_line ch) + 1 in | |
29 | - let char_rows = List.map (List.tl_exn font) ~f:(fun line -> | |
30 | - let row_str = String.(drop_prefix (prefix line end_idx) start_idx) in | |
31 | - let row_list = String.to_list row_str in | |
32 | - Array.of_list_map row_list ~f:uchar_of_char | |
33 | - ) in | |
30 | + let end_idx = String.rindex_exn fst_line ch + 1 in | |
31 | + let char_rows = | |
32 | + List.map (List.tl_exn font) ~f:(fun line -> | |
33 | + let row_str = String.(drop_prefix (prefix line end_idx) start_idx) in | |
34 | + let row_list = String.to_list row_str in | |
35 | + Array.of_list_map row_list ~f:uchar_of_char) | |
36 | + in | |
34 | 37 | |
35 | 38 | (char_rows, end_idx) |
36 | 39 | in |
37 | 40 | |
38 | 41 | let rec map_chars_at map idx = |
39 | - if idx >= String.length fst_line then map else | |
42 | + if idx >= String.length fst_line then map | |
43 | + else | |
40 | 44 | let img, next_idx = extract_char_at idx in |
41 | 45 | let ch = String.get fst_line idx in |
42 | 46 | map_chars_at (Map.add_exn map ~key:ch ~data:img) next_idx |
@@ -46,6 +50,5 @@ let big_font_map = | ||
46 | 50 | |
47 | 51 | let image_of_string attr str = |
48 | 52 | List.map (String.to_list str) ~f:(fun ch -> |
49 | - List.map (Map.find_exn big_font_map ch) ~f:(I.uchars attr) | |
50 | - |> I.vcat | |
51 | - ) |> I.hcat | |
\ No newline at end of file | ||
53 | + List.map (Map.find_exn big_font_map ch) ~f:(I.uchars attr) |> I.vcat) | |
54 | + |> I.hcat |
@@ -5,19 +5,17 @@ let color_of_hexstring str = | ||
5 | 5 | match Color.of_hexstring str with |
6 | 6 | | None -> failwith "Failed to derive color from hexstring" |
7 | 7 | | Some color -> |
8 | - let rgba = Color.to_rgba color in | |
9 | - A.rgb_888 ~r:rgba.r ~g:rgba.g ~b:rgba.b | |
8 | + let rgba = Color.to_rgba color in | |
9 | + A.rgb_888 ~r:rgba.r ~g:rgba.g ~b:rgba.b | |
10 | 10 | |
11 | 11 | let color_of_hsl h s l = |
12 | 12 | let hsl = Color.of_hsl h s l in |
13 | 13 | let rgba = Color.to_rgba hsl in |
14 | 14 | A.rgb_888 ~r:rgba.r ~g:rgba.g ~b:rgba.b |
15 | 15 | |
16 | -let default_bg = A.(bg (color_of_hexstring "#2f3542")) | |
17 | -let selection_bg = A.(bg (color_of_hexstring "#485460")) | |
18 | - | |
19 | -let attr_of_hexstring str = | |
20 | - A.(fg (color_of_hexstring str) ++ default_bg) | |
16 | +let default_bg = A.(bg (color_of_hexstring "#2f3542")) | |
17 | +let selection_bg = A.(bg (color_of_hexstring "#485460")) | |
18 | +let attr_of_hexstring str = A.(fg (color_of_hexstring str) ++ default_bg) | |
21 | 19 | |
22 | 20 | (* https://flatuicolors.com/palette/cn *) |
23 | 21 | (* TODO Find better color palette *) |
@@ -31,6 +29,8 @@ let label = attr_of_hexstring "#a4b0be" | ||
31 | 29 | |
32 | 30 | let rainbow () = |
33 | 31 | let period = 3. in |
34 | - let h = Float.mod_float (Core_unix.gettimeofday ()) period /. period *. 360. in | |
32 | + let h = | |
33 | + Float.mod_float (Core_unix.gettimeofday ()) period /. period *. 360. | |
34 | + in | |
35 | 35 | let rb = color_of_hsl h 1. 0.7 in |
36 | - A.(fg rb ++ default_bg ++ st bold) | |
\ No newline at end of file | ||
36 | + A.(fg rb ++ default_bg ++ st bold) |
@@ -9,10 +9,9 @@ let left_pad width i = | ||
9 | 9 | I.hpad (width - I.width i) 0 i |
10 | 10 | |
11 | 11 | let center_pad width i = |
12 | - if I.width i > width | |
13 | - then I.hcrop 0 (I.width i - width) i | |
12 | + if I.width i > width then I.hcrop 0 (I.width i - width) i | |
14 | 13 | else |
15 | - let pad = (width - I.width i) in | |
14 | + let pad = width - I.width i in | |
16 | 15 | let lpad = pad / 2 in |
17 | 16 | let rpad = pad - lpad in |
18 | 17 | I.hpad lpad rpad i |
@@ -31,9 +30,10 @@ let preamble timer width = | ||
31 | 30 | I.(title <-> category) |
32 | 31 | |
33 | 32 | let splits_header timer width = |
34 | - let labels = match timer.wr with | |
35 | - | Some _ -> ["Delta"; "Sgmt"; "Time"; "WR"] | |
36 | - | None -> ["Delta"; "Sgmt"; "Time"] | |
33 | + let labels = | |
34 | + match timer.wr with | |
35 | + | Some _ -> [ "Delta"; "Sgmt"; "Time"; "WR" ] | |
36 | + | None -> [ "Delta"; "Sgmt"; "Time" ] | |
37 | 37 | in |
38 | 38 | |
39 | 39 | let colored = List.map ~f:(I.string Colors.label) labels in |
@@ -58,18 +58,18 @@ let time_status timer split_num = | ||
58 | 58 | else |
59 | 59 | color depends on whether currently ahead and how lead/loss compares to last available lead/loss |
60 | 60 | *) |
61 | - | |
62 | - if Splits.is_gold timer split_num then Gold else | |
61 | + if Splits.is_gold timer split_num then Gold | |
62 | + else | |
63 | 63 | match Splits.ahead_by timer split_num with |
64 | 64 | | None -> Ahead_gain |
65 | - | Some delta -> | |
66 | - match Splits.ahead_by timer (split_num - 1) with | |
67 | - | None -> (if delta < 0 then Ahead_gain else Behind_loss) | |
68 | - | Some prev_delta -> ( | |
69 | - if delta < 0 | |
70 | - then if delta < prev_delta then Ahead_gain else Ahead_loss | |
71 | - else if delta > prev_delta then Behind_loss else Behind_gain | |
72 | - ) | |
65 | + | Some delta -> ( | |
66 | + match Splits.ahead_by timer (split_num - 1) with | |
67 | + | None -> if delta < 0 then Ahead_gain else Behind_loss | |
68 | + | Some prev_delta -> | |
69 | + if delta < 0 then | |
70 | + if delta < prev_delta then Ahead_gain else Ahead_loss | |
71 | + else if delta > prev_delta then Behind_loss | |
72 | + else Behind_gain) | |
73 | 73 | |
74 | 74 | let time_color timer split_num = |
75 | 75 | match time_status timer split_num with |
@@ -80,39 +80,39 @@ let time_color timer split_num = | ||
80 | 80 | | Gold -> Colors.rainbow () |
81 | 81 | |
82 | 82 | let show_delta timer split_num = |
83 | - (* if previous split or behind or | |
84 | - (if gold available and segment time avail and seg slower than gold): | |
83 | + (* if previous split or behind or | |
84 | + (if gold available and segment time avail and seg slower than gold): | |
85 | 85 | show |
86 | - else | |
87 | - hide | |
86 | + else | |
87 | + hide | |
88 | 88 | *) |
89 | 89 | match timer.state with |
90 | 90 | | Idle -> false |
91 | - | Timing (splits, _) | Paused (splits, _, _) | Done (splits, _) -> | |
92 | - if split_num < Array.length splits then true else | |
93 | - (match time_status timer split_num with | |
94 | - | Behind_gain | Behind_loss -> true | |
95 | - | Ahead_gain | Ahead_loss | Gold -> | |
96 | - let sgmt = Splits.segment_time timer split_num in | |
97 | - let gold = timer.golds.(split_num).duration in | |
98 | - (match sgmt, gold with | |
99 | - | Some s, Some g -> s > g | |
100 | - | _ -> false | |
101 | - ) | |
102 | - ) | |
91 | + | Timing (splits, _) | Paused (splits, _, _) | Done (splits, _) -> ( | |
92 | + if split_num < Array.length splits then true | |
93 | + else | |
94 | + match time_status timer split_num with | |
95 | + | Behind_gain | Behind_loss -> true | |
96 | + | Ahead_gain | Ahead_loss | Gold -> ( | |
97 | + let sgmt = Splits.segment_time timer split_num in | |
98 | + let gold = timer.golds.(split_num).duration in | |
99 | + match (sgmt, gold) with Some s, Some g -> s > g | _ -> false)) | |
103 | 100 | |
104 | 101 | let split_row timer width i = |
105 | - let bg_attr = match timer.state with | |
102 | + let bg_attr = | |
103 | + match timer.state with | |
106 | 104 | | Idle | Done _ -> Colors.default_bg |
107 | 105 | | Timing (splits, _) | Paused (splits, _, _) -> |
108 | - if i = Array.length splits then Colors.selection_bg else Colors.default_bg | |
106 | + if i = Array.length splits then Colors.selection_bg | |
107 | + else Colors.default_bg | |
109 | 108 | in |
110 | 109 | let uncolored_attr = A.(Colors.text ++ bg_attr) in |
111 | 110 | |
112 | - let curr_split = match timer.state with | |
111 | + let curr_split = | |
112 | + match timer.state with | |
113 | 113 | | Idle -> -1 |
114 | 114 | | Timing (splits, _) | Paused (splits, _, _) | Done (splits, _) -> |
115 | - Array.length splits | |
115 | + Array.length splits | |
116 | 116 | in |
117 | 117 | let show_comparison = i > curr_split in |
118 | 118 |
@@ -120,24 +120,22 @@ let split_row timer width i = | ||
120 | 120 | |
121 | 121 | (* Compute the split's ahead/behind time image *) |
122 | 122 | let delta_image = |
123 | - if show_comparison then | |
124 | - I.string uncolored_attr "-" | |
123 | + if show_comparison then I.string uncolored_attr "-" | |
125 | 124 | else |
126 | 125 | match Splits.ahead_by timer i with |
127 | 126 | | None -> I.string uncolored_attr "-" |
128 | - | Some delta -> ( | |
129 | - if not (show_delta timer i) then I.string uncolored_attr "" else | |
127 | + | Some delta -> | |
128 | + if not (show_delta timer i) then I.string uncolored_attr "" | |
129 | + else | |
130 | 130 | let time_str = Duration.to_string_plus delta 1 in |
131 | 131 | let color = A.(time_color timer i ++ bg_attr) in |
132 | 132 | I.string color time_str |
133 | - ) | |
134 | 133 | in |
135 | 134 | |
136 | 135 | (* Compute the image of the split's segment time *) |
137 | 136 | let sgmt_image = |
138 | 137 | let seg_time = |
139 | - if show_comparison | |
140 | - then Splits.archived_segment_time timer i | |
138 | + if show_comparison then Splits.archived_segment_time timer i | |
141 | 139 | else Splits.segment_time timer i |
142 | 140 | in |
143 | 141 |
@@ -148,50 +146,50 @@ let split_row timer width i = | ||
148 | 146 | |
149 | 147 | (* Compute the image of the split's absolute time *) |
150 | 148 | let time = |
151 | - if show_comparison | |
152 | - then Splits.archived_split_time timer i | |
149 | + if show_comparison then Splits.archived_split_time timer i | |
153 | 150 | else Splits.split_time timer i |
154 | 151 | in |
155 | - let time_str = match time with | |
156 | - | Some t -> Duration.to_string t 1 | |
157 | - | None -> "-" | |
152 | + let time_str = | |
153 | + match time with Some t -> Duration.to_string t 1 | None -> "-" | |
158 | 154 | in |
159 | 155 | let time_image = I.string uncolored_attr time_str in |
160 | 156 | |
161 | 157 | (* Compute the image of the WR comparison cell *) |
162 | - let wr_image = match timer.wr with | |
158 | + let wr_image = | |
159 | + match timer.wr with | |
163 | 160 | | None -> None |
164 | - | Some wr_run -> | |
165 | - let default_img = | |
166 | - match wr_run.splits.(i).time with | |
167 | - | Some t -> Some (I.string uncolored_attr (Duration.to_string t 2)) | |
168 | - | None -> Some (I.string uncolored_attr "-") | |
169 | - in | |
170 | - | |
171 | - if i >= curr_split then default_img else | |
172 | - | |
173 | - (* Determine how much we're ahead or behind WR *) | |
174 | - match timer.state with | |
175 | - | Idle -> default_img | |
176 | - | Timing (splits, _) | Paused (splits, _, _) | Done (splits, _) -> ( | |
177 | - match splits.(i), wr_run.splits.(i).time with | |
178 | - | Some curr_t, Some wr_t -> | |
179 | - let delta = curr_t - wr_t in | |
180 | - let delta_str = Duration.to_string_plus delta 2 in | |
181 | - let delta_color = if delta < 0 then Colors.ahead_gain else Colors.behind_gain in | |
182 | - Some (I.string delta_color delta_str) | |
183 | - | _ -> Some (I.string uncolored_attr "-") | |
184 | - ) | |
161 | + | Some wr_run -> ( | |
162 | + let default_img = | |
163 | + match wr_run.splits.(i).time with | |
164 | + | Some t -> Some (I.string uncolored_attr (Duration.to_string t 2)) | |
165 | + | None -> Some (I.string uncolored_attr "-") | |
166 | + in | |
167 | + | |
168 | + if i >= curr_split then default_img | |
169 | + else | |
170 | + (* Determine how much we're ahead or behind WR *) | |
171 | + match timer.state with | |
172 | + | Idle -> default_img | |
173 | + | Timing (splits, _) | Paused (splits, _, _) | Done (splits, _) -> ( | |
174 | + match (splits.(i), wr_run.splits.(i).time) with | |
175 | + | Some curr_t, Some wr_t -> | |
176 | + let delta = curr_t - wr_t in | |
177 | + let delta_str = Duration.to_string_plus delta 2 in | |
178 | + let delta_color = | |
179 | + if delta < 0 then Colors.ahead_gain else Colors.behind_gain | |
180 | + in | |
181 | + Some (I.string delta_color delta_str) | |
182 | + | _ -> Some (I.string uncolored_attr "-"))) | |
185 | 183 | in |
186 | 184 | |
187 | 185 | (* Combine the three time columns together with proper padding *) |
188 | - let time_cells = match wr_image with | |
189 | - | Some wr -> [delta_image; sgmt_image; time_image; wr] | |
190 | - | None -> [delta_image; sgmt_image; time_image] | |
186 | + let time_cells = | |
187 | + match wr_image with | |
188 | + | Some wr -> [ delta_image; sgmt_image; time_image; wr ] | |
189 | + | None -> [ delta_image; sgmt_image; time_image ] | |
191 | 190 | in |
192 | 191 | let time_cols_combined = |
193 | - List.map time_cells ~f:(left_pad time_col_width) | |
194 | - |> I.hcat | |
192 | + List.map time_cells ~f:(left_pad time_col_width) |> I.hcat | |
195 | 193 | in |
196 | 194 | |
197 | 195 | (* Add the split title and background color to fill in the padding *) |
@@ -204,87 +202,91 @@ let splits timer width = | ||
204 | 202 | |> Array.to_list |> I.vcat |
205 | 203 | |
206 | 204 | let big_timer timer width = |
207 | - let time, color = match timer.state with | |
208 | - | Idle -> 0, Colors.idle | |
209 | - | |
205 | + let time, color = | |
206 | + match timer.state with | |
207 | + | Idle -> (0, Colors.idle) | |
210 | 208 | | Timing (splits, start_time) -> |
211 | - let time = Duration.since start_time in | |
212 | - let color = time_color timer (Array.length splits) in | |
213 | - time, color | |
214 | - | |
209 | + let time = Duration.since start_time in | |
210 | + let color = time_color timer (Array.length splits) in | |
211 | + (time, color) | |
215 | 212 | | Paused (splits, start_time, pause_time) -> |
216 | - let time = Duration.between start_time pause_time in | |
217 | - let color = time_color timer (Array.length splits) in | |
218 | - time, color | |
219 | - | |
213 | + let time = Duration.between start_time pause_time in | |
214 | + let color = time_color timer (Array.length splits) in | |
215 | + (time, color) | |
220 | 216 | | Done (splits, _) -> ( |
221 | 217 | let last_split_num = Array.length splits - 1 in |
222 | 218 | match splits.(last_split_num) with |
223 | 219 | | None -> failwith "Last split found empty on done" |
224 | 220 | | Some time -> ( |
225 | 221 | match timer.comparison with |
226 | - | None -> time, Colors.ahead_gain | |
222 | + | None -> (time, Colors.ahead_gain) | |
227 | 223 | | Some comp -> ( |
228 | 224 | match comp.splits.(last_split_num).time with |
229 | 225 | | None -> failwith "Last split of comparison found empty" |
230 | 226 | | Some comp_time -> |
231 | - let color = if time < comp_time then Colors.rainbow () else Colors.behind_loss in | |
232 | - time, color | |
233 | - ) | |
234 | - ) | |
235 | - ) | |
227 | + let color = | |
228 | + if time < comp_time then Colors.rainbow () | |
229 | + else Colors.behind_loss | |
230 | + in | |
231 | + (time, color)))) | |
236 | 232 | in |
237 | 233 | |
238 | - Duration.to_string time 2 | |
239 | - |> Big.image_of_string color | |
240 | - |> left_pad width | |
234 | + Duration.to_string time 2 |> Big.image_of_string color |> left_pad width | |
241 | 235 | |
242 | 236 | let previous_segment timer width = |
243 | 237 | let desc_img = I.string Colors.default_bg "Previous Segment" in |
244 | 238 | let empty_time_img = I.string Colors.default_bg "-" in |
245 | 239 | |
246 | - let time_img = match timer.state with | |
240 | + let time_img = | |
241 | + match timer.state with | |
247 | 242 | | Idle -> empty_time_img |
248 | - | Timing (splits, _) | Paused (splits, _, _) | Done (splits, _) -> | |
249 | - let curr_split = Array.length splits in | |
250 | - let prev_delta = Splits.ahead_by timer (curr_split - 1) in | |
251 | - let prev_prev_delta = Splits.ahead_by timer (curr_split - 2) in | |
252 | - (match prev_delta, prev_prev_delta with | |
253 | - | Some pd, Some ppd -> | |
254 | - let diff = pd - ppd in | |
255 | - let diff_str = Duration.to_string_plus diff 2 in | |
256 | - let color = if diff < 0 then Colors.ahead_gain else Colors.behind_loss in | |
257 | - I.string color diff_str | |
258 | - | _ -> empty_time_img | |
259 | - ) | |
243 | + | Timing (splits, _) | Paused (splits, _, _) | Done (splits, _) -> ( | |
244 | + let curr_split = Array.length splits in | |
245 | + let prev_delta = Splits.ahead_by timer (curr_split - 1) in | |
246 | + let prev_prev_delta = Splits.ahead_by timer (curr_split - 2) in | |
247 | + match (prev_delta, prev_prev_delta) with | |
248 | + | Some pd, Some ppd -> | |
249 | + let diff = pd - ppd in | |
250 | + let diff_str = Duration.to_string_plus diff 2 in | |
251 | + let color = | |
252 | + if diff < 0 then Colors.ahead_gain else Colors.behind_loss | |
253 | + in | |
254 | + I.string color diff_str | |
255 | + | _ -> empty_time_img) | |
260 | 256 | in |
261 | 257 | |
262 | 258 | join_pad width desc_img time_img |
263 | 259 | |
264 | 260 | let best_possible_time timer width = |
265 | - let t = match timer.state with | |
261 | + let t = | |
262 | + match timer.state with | |
266 | 263 | | Idle -> Splits.gold_sum timer 0 (Array.length timer.split_names) |
267 | - | Timing (splits, _) | Paused (splits, _, _) -> | |
268 | - let curr_split = Array.length splits in | |
269 | - let total_splits = Array.length timer.split_names in | |
270 | - | |
271 | - let future_sob = Splits.gold_sum timer (curr_split + 1) (total_splits) in | |
272 | - let curr_gold = (Splits.updated_golds timer).(curr_split).duration in | |
273 | - let last_split_time = if curr_split = 0 then Some 0 else splits.(curr_split - 1) in | |
274 | - let curr_seg = Splits.segment_time timer curr_split in | |
275 | - | |
276 | - (match future_sob, curr_gold, last_split_time, curr_seg with | |
277 | - | Some future_sob', Some curr_gold', Some last_split_time', Some curr_seg' -> | |
278 | - Some (last_split_time' + max curr_seg' curr_gold' + future_sob') | |
279 | - | _ -> None | |
280 | - ) | |
264 | + | Timing (splits, _) | Paused (splits, _, _) -> ( | |
265 | + let curr_split = Array.length splits in | |
266 | + let total_splits = Array.length timer.split_names in | |
267 | + | |
268 | + let future_sob = Splits.gold_sum timer (curr_split + 1) total_splits in | |
269 | + let curr_gold = (Splits.updated_golds timer).(curr_split).duration in | |
270 | + let last_split_time = | |
271 | + if curr_split = 0 then Some 0 else splits.(curr_split - 1) | |
272 | + in | |
273 | + let curr_seg = Splits.segment_time timer curr_split in | |
274 | + | |
275 | + match (future_sob, curr_gold, last_split_time, curr_seg) with | |
276 | + | ( Some future_sob', | |
277 | + Some curr_gold', | |
278 | + Some last_split_time', | |
279 | + Some curr_seg' ) -> | |
280 | + Some (last_split_time' + max curr_seg' curr_gold' + future_sob') | |
281 | + | _ -> None) | |
281 | 282 | | Done (splits, _) -> splits.(Array.length splits - 1) |
282 | 283 | in |
283 | 284 | |
284 | - let time_img = match t with | |
285 | + let time_img = | |
286 | + match t with | |
285 | 287 | | Some t' -> |
286 | - let time_str = Duration.to_string t' 2 in | |
287 | - I.string Colors.text time_str | |
288 | + let time_str = Duration.to_string t' 2 in | |
289 | + I.string Colors.text time_str | |
288 | 290 | | None -> I.string Colors.text "-" |
289 | 291 | in |
290 | 292 |
@@ -293,7 +295,8 @@ let best_possible_time timer width = | ||
293 | 295 | |
294 | 296 | let sob timer width = |
295 | 297 | let sob_time = Splits.gold_sum timer 0 (Array.length timer.split_names) in |
296 | - let sob_img = match sob_time with | |
298 | + let sob_img = | |
299 | + match sob_time with | |
297 | 300 | | Some sob -> I.string Colors.text (Duration.to_string sob 2) |
298 | 301 | | None -> I.empty |
299 | 302 | in |
@@ -304,10 +307,9 @@ let sob timer width = | ||
304 | 307 | (* Result might be slightly bigger than given size *) |
305 | 308 | let rec subdivide_space color w h max_size = |
306 | 309 | if w > max_size || h > max_size then |
307 | - let subspace = subdivide_space color (w / 2 + 1) (h / 2 + 1) max_size in | |
308 | - I.((subspace <|> subspace) <-> (subspace <|> subspace)) | |
309 | - else | |
310 | - I.char color ' ' w h | |
310 | + let subspace = subdivide_space color ((w / 2) + 1) ((h / 2) + 1) max_size in | |
311 | + I.(subspace <|> subspace <-> (subspace <|> subspace)) | |
312 | + else I.char color ' ' w h | |
311 | 313 | |
312 | 314 | let display timer (w, h) = |
313 | 315 | (* TODO remedy this Notty bug workaround |
@@ -319,28 +321,18 @@ let display timer (w, h) = | ||
319 | 321 | a few different terminals (Gnome-terminal, Termite, urxvt, not xterm though) |
320 | 322 | *) |
321 | 323 | I.( |
322 | - ( | |
323 | - preamble timer w <-> | |
324 | - void w 1 <-> | |
325 | - splits_header timer w <-> | |
326 | - splits timer w <-> | |
327 | - void w 1 <-> | |
328 | - big_timer timer w <-> | |
329 | - previous_segment timer w <-> | |
330 | - sob timer w <-> | |
331 | - best_possible_time timer w | |
332 | - ) </> subdivide_space Colors.default_bg w h 10 | |
333 | - ) | |
324 | + preamble timer w <-> void w 1 <-> splits_header timer w <-> splits timer w | |
325 | + <-> void w 1 <-> big_timer timer w <-> previous_segment timer w | |
326 | + <-> sob timer w <-> best_possible_time timer w | |
327 | + </> subdivide_space Colors.default_bg w h 10) | |
334 | 328 | |
335 | 329 | type t = Notty_unix.Term.t |
336 | 330 | |
337 | -let make () = | |
338 | - Notty_unix.Term.create () | |
331 | +let make () = Notty_unix.Term.create () | |
339 | 332 | |
340 | 333 | let draw term timer = |
341 | 334 | let open Notty_unix in |
342 | 335 | let image = display timer (Term.size term) in |
343 | 336 | Term.image term image |
344 | 337 | |
345 | -let close term = | |
346 | - Notty_unix.Term.release term | |
338 | +let close term = Notty_unix.Term.release term |
@@ -10,8 +10,8 @@ let hour : t = minute * 60 | ||
10 | 10 | let day : t = hour * 60 |
11 | 11 | |
12 | 12 | let compiled_re = |
13 | - {|^(?:(?:(?:(\d+):)?(\d+):)?(\d+):)?(\d+)(?:\.(\d{1,3}))?$|} | |
14 | - |> Re.Perl.re |> Re.compile | |
13 | + {|^(?:(?:(?:(\d+):)?(\d+):)?(\d+):)?(\d+)(?:\.(\d{1,3}))?$|} |> Re.Perl.re | |
14 | + |> Re.compile | |
15 | 15 | |
16 | 16 | let string_valid = Re.execp compiled_re |
17 | 17 |
@@ -22,36 +22,35 @@ let left_pad_zeros_char_list str size = | ||
22 | 22 | prepend (String.to_list str) (size - String.length str) |
23 | 23 | |
24 | 24 | let left_pad_zeros size str = |
25 | - left_pad_zeros_char_list str size | |
26 | - |> String.of_char_list | |
25 | + left_pad_zeros_char_list str size |> String.of_char_list | |
27 | 26 | |
28 | 27 | let of_string str = |
29 | 28 | match Re.exec_opt compiled_re str with |
30 | 29 | | None -> None |
31 | 30 | | Some groups -> |
32 | - let group_strs = Re.Group.all groups in | |
31 | + let group_strs = Re.Group.all groups in | |
33 | 32 | |
34 | - let to_int_default x = if String.length x = 0 then 0 else Int.of_string x in | |
33 | + let to_int_default x = | |
34 | + if String.length x = 0 then 0 else Int.of_string x | |
35 | + in | |
35 | 36 | |
36 | - let days = group_strs.(1) |> to_int_default in | |
37 | - let hours = group_strs.(2) |> to_int_default in | |
38 | - let minutes = group_strs.(3) |> to_int_default in | |
39 | - let seconds = group_strs.(4) |> to_int_default in | |
40 | - let millis = group_strs.(5) |> left_pad_zeros 3 |> to_int_default in | |
37 | + let days = group_strs.(1) |> to_int_default in | |
38 | + let hours = group_strs.(2) |> to_int_default in | |
39 | + let minutes = group_strs.(3) |> to_int_default in | |
40 | + let seconds = group_strs.(4) |> to_int_default in | |
41 | + let millis = group_strs.(5) |> left_pad_zeros 3 |> to_int_default in | |
41 | 42 | |
42 | - Some ( | |
43 | - day * days + | |
44 | - hour * hours + | |
45 | - minute * minutes + | |
46 | - second * seconds + | |
47 | - milli * millis | |
48 | - ) | |
43 | + Some | |
44 | + ((day * days) + (hour * hours) + (minute * minutes) + (second * seconds) | |
45 | + + (milli * millis)) | |
49 | 46 | |
50 | -let t_of_sexp sexp = match sexp with | |
47 | +let t_of_sexp sexp = | |
48 | + match sexp with | |
51 | 49 | | Sexp.List _ -> of_sexp_error "Durations should be strings, not lists" sexp |
52 | - | Sexp.Atom s -> match of_string s with | |
53 | - | None -> of_sexp_error "Invalid duration string" sexp | |
54 | - | Some d -> d | |
50 | + | Sexp.Atom s -> ( | |
51 | + match of_string s with | |
52 | + | None -> of_sexp_error "Invalid duration string" sexp | |
53 | + | Some d -> d) | |
55 | 54 | |
56 | 55 | let to_string_pos duration decimals = |
57 | 56 | let days = duration / day in |
@@ -66,37 +65,31 @@ let to_string_pos duration decimals = | ||
66 | 65 | let seconds = duration_minute / second in |
67 | 66 | let millis = duration_minute % second in |
68 | 67 | |
69 | - let millis_str = | |
68 | + let millis_str = | |
70 | 69 | let zero_padded = left_pad_zeros 3 (Int.to_string millis) in |
71 | 70 | String.prefix zero_padded decimals |
72 | 71 | in |
73 | - let seconds_str = | |
72 | + let seconds_str = | |
74 | 73 | let str = Int.to_string seconds in |
75 | 74 | if duration >= minute then left_pad_zeros 2 str else str |
76 | 75 | in |
77 | 76 | |
78 | 77 | let minutes_str = |
79 | - if duration >= hour | |
80 | - then (Int.to_string minutes |> left_pad_zeros 2) ^ ":" | |
81 | - else if duration >= minute then Int.to_string minutes ^ ":" else "" | |
78 | + if duration >= hour then (Int.to_string minutes |> left_pad_zeros 2) ^ ":" | |
79 | + else if duration >= minute then Int.to_string minutes ^ ":" | |
80 | + else "" | |
82 | 81 | in |
83 | 82 | |
84 | 83 | let hours_str = |
85 | - if duration >= day | |
86 | - then (Int.to_string hours |> left_pad_zeros 2) ^ ":" | |
87 | - else if duration >= hour then Int.to_string hours ^ ":" else "" | |
84 | + if duration >= day then (Int.to_string hours |> left_pad_zeros 2) ^ ":" | |
85 | + else if duration >= hour then Int.to_string hours ^ ":" | |
86 | + else "" | |
88 | 87 | in |
89 | 88 | |
90 | 89 | let days_str = if duration >= day then Int.to_string days ^ ":" else "" in |
91 | 90 | |
92 | - String.concat [ | |
93 | - days_str; | |
94 | - hours_str; | |
95 | - minutes_str; | |
96 | - seconds_str; | |
97 | - "."; | |
98 | - millis_str; | |
99 | - ] | |
91 | + String.concat | |
92 | + [ days_str; hours_str; minutes_str; seconds_str; "."; millis_str ] | |
100 | 93 | |
101 | 94 | let to_string duration decimals = |
102 | 95 | if duration < 0 then "-" ^ to_string_pos (-duration) decimals |
@@ -108,8 +101,5 @@ let to_string_plus duration decimals = | ||
108 | 101 | let str = to_string duration decimals in |
109 | 102 | if duration >= 0 then "+" ^ str else str |
110 | 103 | |
111 | -let between start finish = | |
112 | - (finish -. start) *. 1000. |> Int.of_float | |
113 | - | |
114 | -let since time_float = | |
115 | - between time_float (Core_unix.gettimeofday ()) | |
104 | +let between start finish = (finish -. start) *. 1000. |> Int.of_float | |
105 | +let since time_float = between time_float (Core_unix.gettimeofday ()) |
@@ -17,7 +17,9 @@ let draw_event flitter = | ||
17 | 17 | |
18 | 18 | let deadline = flitter.last_draw +. period in |
19 | 19 | let delay = deadline -. Core_unix.gettimeofday () in |
20 | - let%lwt () = if Float.(delay > 0.) then Lwt_unix.sleep delay else Lwt.return_unit in | |
20 | + let%lwt () = | |
21 | + if Float.(delay > 0.) then Lwt_unix.sleep delay else Lwt.return_unit | |
22 | + in | |
21 | 23 | Lwt.return Draw_tick |
22 | 24 | |
23 | 25 | let keyboard_event flitter = |
@@ -32,143 +34,131 @@ let array_replace arr i value = | ||
32 | 34 | |
33 | 35 | let handle_key flitter (t, key_str) = |
34 | 36 | let timer = flitter.timer in |
35 | - let new_timer = match flitter.timer.state with | |
37 | + let new_timer = | |
38 | + match flitter.timer.state with | |
36 | 39 | | Idle -> ( |
37 | 40 | match key_str with |
38 | - | "space" | "j" -> { | |
39 | - timer with | |
40 | - state = Timing ([||], t) | |
41 | - } | |
41 | + | "space" | "j" -> { timer with state = Timing ([||], t) } | |
42 | 42 | | "q" -> raise Stdlib.Exit |
43 | - | _ -> timer | |
44 | - ) | |
45 | - | |
43 | + | _ -> timer) | |
46 | 44 | | Timing (splits, start_time) -> ( |
47 | 45 | let curr_split = Array.length splits in |
48 | 46 | match key_str with |
49 | - | "space" | "j" -> | |
50 | - let curr_split_time = Some (Duration.between start_time t) in | |
51 | - let new_splits = Array.append splits [|curr_split_time|] in | |
52 | - | |
53 | - let new_state = | |
54 | - if Array.length new_splits = Array.length timer.split_names | |
55 | - then Done (new_splits, start_time) | |
56 | - else Timing (new_splits, start_time) | |
57 | - in | |
58 | - {timer with state = new_state} | |
59 | - | |
60 | - | "k" -> | |
61 | - let new_state = | |
62 | - match curr_split with | |
63 | - | 0 -> Idle | |
64 | - | 1 -> Timing ([||], start_time) | |
65 | - | _ -> Timing ((Array.slice splits 0 (curr_split - 1)), start_time) | |
66 | - in | |
67 | - {timer with state = new_state} | |
68 | - | |
69 | - | "backspace" | "delete" -> {timer with state = Paused (splits, start_time, t)} | |
70 | - | |
71 | - | "d" -> | |
72 | - let new_state = | |
73 | - if curr_split > 0 then | |
74 | - let new_splits = array_replace splits (curr_split - 1) None in | |
75 | - Timing (new_splits, start_time) | |
76 | - else | |
77 | - Idle | |
78 | - in | |
79 | - {timer with state = new_state} | |
80 | - | |
81 | - | _ -> timer | |
82 | - ) | |
83 | - | |
47 | + | "space" | "j" -> | |
48 | + let curr_split_time = Some (Duration.between start_time t) in | |
49 | + let new_splits = Array.append splits [| curr_split_time |] in | |
50 | + | |
51 | + let new_state = | |
52 | + if Array.length new_splits = Array.length timer.split_names then | |
53 | + Done (new_splits, start_time) | |
54 | + else Timing (new_splits, start_time) | |
55 | + in | |
56 | + { timer with state = new_state } | |
57 | + | "k" -> | |
58 | + let new_state = | |
59 | + match curr_split with | |
60 | + | 0 -> Idle | |
61 | + | 1 -> Timing ([||], start_time) | |
62 | + | _ -> Timing (Array.slice splits 0 (curr_split - 1), start_time) | |
63 | + in | |
64 | + { timer with state = new_state } | |
65 | + | "backspace" | "delete" -> | |
66 | + { timer with state = Paused (splits, start_time, t) } | |
67 | + | "d" -> | |
68 | + let new_state = | |
69 | + if curr_split > 0 then | |
70 | + let new_splits = array_replace splits (curr_split - 1) None in | |
71 | + Timing (new_splits, start_time) | |
72 | + else Idle | |
73 | + in | |
74 | + { timer with state = new_state } | |
75 | + | _ -> timer) | |
84 | 76 | | Paused (splits, start_time, pause_time) -> ( |
85 | 77 | match key_str with |
86 | - | "space" | "j" -> | |
87 | - let new_state = Timing (splits, start_time +. t -. pause_time) in | |
88 | - {timer with state = new_state} | |
89 | - | |
90 | - | "backspace" -> | |
91 | - let new_timer = { | |
92 | - timer with | |
93 | - state = Idle; | |
94 | - golds = Splits.updated_golds timer; | |
95 | - attempts = timer.attempts + 1; | |
96 | - } in | |
97 | - Loadsave.save new_timer; | |
98 | - new_timer | |
99 | - | |
100 | - | "delete" -> {timer with state = Idle} | |
101 | - | _ -> timer | |
102 | - ) | |
103 | - | |
78 | + | "space" | "j" -> | |
79 | + let new_state = Timing (splits, start_time +. t -. pause_time) in | |
80 | + { timer with state = new_state } | |
81 | + | "backspace" -> | |
82 | + let new_timer = | |
83 | + { | |
84 | + timer with | |
85 | + state = Idle; | |
86 | + golds = Splits.updated_golds timer; | |
87 | + attempts = timer.attempts + 1; | |
88 | + } | |
89 | + in | |
90 | + Loadsave.save new_timer; | |
91 | + new_timer | |
92 | + | "delete" -> { timer with state = Idle } | |
93 | + | _ -> timer) | |
104 | 94 | | Done (splits, start_time) -> ( |
105 | 95 | match key_str with |
106 | 96 | | "space" | "backspace" -> |
107 | - let archived_run = Splits.archive_done_run timer splits in | |
108 | - let pb = Splits.updated_pb timer in | |
109 | - | |
110 | - let new_timer = { | |
111 | - timer with | |
112 | - state = Idle; | |
113 | - golds = Splits.updated_golds timer; | |
114 | - attempts = timer.attempts + 1; | |
115 | - completed = timer.completed + 1; | |
116 | - history = archived_run :: timer.history; | |
117 | - pb = pb; | |
118 | - comparison = pb; | |
119 | - } in | |
120 | - | |
121 | - Loadsave.save new_timer; | |
122 | - new_timer | |
123 | - | |
124 | - | "delete" -> {timer with state = Idle} | |
125 | - | |
126 | - | "k" -> | |
127 | - let new_splits = if Array.length splits = 1 | |
128 | - then [||] | |
129 | - else Array.(slice splits 0 (length splits - 1)) | |
130 | - in | |
131 | - {timer with state = Timing (new_splits, start_time)} | |
132 | - | |
97 | + let archived_run = Splits.archive_done_run timer splits in | |
98 | + let pb = Splits.updated_pb timer in | |
99 | + | |
100 | + let new_timer = | |
101 | + { | |
102 | + timer with | |
103 | + state = Idle; | |
104 | + golds = Splits.updated_golds timer; | |
105 | + attempts = timer.attempts + 1; | |
106 | + completed = timer.completed + 1; | |
107 | + history = archived_run :: timer.history; | |
108 | + pb; | |
109 | + comparison = pb; | |
110 | + } | |
111 | + in | |
112 | + | |
113 | + Loadsave.save new_timer; | |
114 | + new_timer | |
115 | + | "delete" -> { timer with state = Idle } | |
116 | + | "k" -> | |
117 | + let new_splits = | |
118 | + if Array.length splits = 1 then [||] | |
119 | + else Array.(slice splits 0 (length splits - 1)) | |
120 | + in | |
121 | + { timer with state = Timing (new_splits, start_time) } | |
133 | 122 | | "q" -> raise Stdlib.Exit |
134 | - | _ -> timer | |
135 | - ) | |
123 | + | _ -> timer) | |
136 | 124 | in |
137 | - {flitter with timer = new_timer} | |
125 | + { flitter with timer = new_timer } | |
138 | 126 | |
139 | 127 | let handle_draw flitter = |
140 | 128 | let draw_time = Core_unix.gettimeofday () in |
141 | 129 | Display.draw flitter.display flitter.timer; |
142 | - {flitter with last_draw = draw_time} | |
130 | + { flitter with last_draw = draw_time } | |
143 | 131 | |
144 | 132 | let rec handle_events flitter events = |
145 | 133 | match events with |
146 | - | evt :: remaining_evts -> ( | |
147 | - let new_flitter = match evt with | |
134 | + | evt :: remaining_evts -> | |
135 | + let new_flitter = | |
136 | + match evt with | |
148 | 137 | | Draw_tick -> handle_draw flitter |
149 | 138 | | Key keypress -> handle_key flitter keypress |
150 | 139 | in |
151 | 140 | |
152 | 141 | handle_events new_flitter remaining_evts |
153 | - ) | |
154 | - | |
155 | 142 | | [] -> flitter |
156 | 143 | |
157 | 144 | let make timer = |
158 | 145 | let%lwt hotkeys_stream = Hotkeys.make_stream () in |
159 | - Lwt.return { | |
160 | - timer = timer; | |
161 | - display = Display.make (); | |
162 | - (* Make sure we're due for a draw *) | |
163 | - last_draw = Core_unix.gettimeofday () -. (1. /. draw_rate); | |
164 | - hotkeys_stream = hotkeys_stream; | |
165 | - } | |
146 | + Lwt.return | |
147 | + { | |
148 | + timer; | |
149 | + display = Display.make (); | |
150 | + (* Make sure we're due for a draw *) | |
151 | + last_draw = Core_unix.gettimeofday () -. (1. /. draw_rate); | |
152 | + hotkeys_stream; | |
153 | + } | |
166 | 154 | |
167 | 155 | let loop flitter = |
168 | 156 | let rec loop' flitter = |
169 | - let%lwt events = Lwt.npick [(draw_event flitter); (keyboard_event flitter)] in | |
157 | + let%lwt events = Lwt.npick [ draw_event flitter; keyboard_event flitter ] in | |
170 | 158 | match handle_events flitter events with |
171 | 159 | | new_flitter -> loop' new_flitter |
172 | - | exception Stdlib.Exit -> Display.close flitter.display; Lwt.return () | |
160 | + | exception Stdlib.Exit -> | |
161 | + Display.close flitter.display; | |
162 | + Lwt.return () | |
173 | 163 | in |
174 | - loop' flitter | |
\ No newline at end of file | ||
164 | + loop' flitter |
@@ -1,8 +1,6 @@ | ||
1 | -let usage = | |
2 | - "Usage:\n" ^ | |
3 | - | |
4 | - "flitter <splits_path>\n" ^ | |
5 | - "Open the splits file pointed to by `splits_path`.\n" | |
1 | +let usage = | |
2 | + "Usage:\n" ^ "flitter <splits_path>\n" | |
3 | + ^ "Open the splits file pointed to by `splits_path`.\n" | |
6 | 4 | |
7 | 5 | let run_event_loop timer = |
8 | 6 | let%lwt event_loop = Event_loop.make timer in |
@@ -10,8 +8,7 @@ let run_event_loop timer = | ||
10 | 8 | |
11 | 9 | let run () = |
12 | 10 | match Sys.argv with |
13 | - | [|_; path|] -> | |
14 | - let timer = Loadsave.load path in | |
15 | - Lwt_main.run (run_event_loop timer) | |
16 | - | |
17 | - | _ -> print_string usage | |
\ No newline at end of file | ||
11 | + | [| _; path |] -> | |
12 | + let timer = Loadsave.load path in | |
13 | + Lwt_main.run (run_event_loop timer) | |
14 | + | _ -> print_string usage |
@@ -3,7 +3,8 @@ open Core | ||
3 | 3 | type keypress = float * string |
4 | 4 | type t = keypress Lwt_stream.t |
5 | 5 | |
6 | -let python_detect_keys = {| | |
6 | +let python_detect_keys = | |
7 | + {| | |
7 | 8 | import time |
8 | 9 | import sys |
9 | 10 | from pynput import keyboard |
@@ -35,33 +36,33 @@ with keyboard.Listener(on_press=on_press) as listener: | ||
35 | 36 | |} |
36 | 37 | |
37 | 38 | let stream_of_python python_src = |
38 | - let cmd = "", [|"python3"; "-"|] in | |
39 | + let cmd = ("", [| "python3"; "-" |]) in | |
39 | 40 | let pipe_out_fd, pipe_out_fd_unix = Lwt_unix.pipe_out () in |
40 | 41 | let () = Lwt_unix.set_close_on_exec pipe_out_fd_unix in |
41 | 42 | let redir = `FD_move pipe_out_fd in |
42 | 43 | |
43 | 44 | let py_stream = Lwt_process.pread_lines ~stdin:redir cmd in |
44 | 45 | |
45 | - let%lwt n = Lwt_unix.write_string pipe_out_fd_unix python_src 0 (String.length python_src) in | |
46 | - if n < String.length python_src then failwith "Failed to write python to pipe" | |
47 | - else | |
46 | + let%lwt n = | |
47 | + Lwt_unix.write_string pipe_out_fd_unix python_src 0 | |
48 | + (String.length python_src) | |
49 | + in | |
50 | + if n < String.length python_src then failwith "Failed to write python to pipe" | |
51 | + else | |
48 | 52 | let%lwt () = Lwt_unix.close pipe_out_fd_unix in |
49 | 53 | Lwt.return py_stream |
50 | 54 | |
51 | 55 | let make_stream () = |
52 | 56 | let%lwt str_stream = stream_of_python python_detect_keys in |
53 | - let stream = Lwt_stream.from (fun () -> | |
54 | - match%lwt Lwt_stream.get str_stream with | |
55 | - | Some str -> ( | |
56 | - match String.split str ~on:' ' with | |
57 | - | time_str :: key_str :: [] -> | |
58 | - Lwt.return (Some ((Float.of_string time_str), key_str)) | |
59 | - | |
60 | - | _ -> failwith "Invalid output from Python keypress server" | |
61 | - | |
62 | - ) | |
63 | - | None -> Lwt.return None | |
64 | - ) | |
57 | + let stream = | |
58 | + Lwt_stream.from (fun () -> | |
59 | + match%lwt Lwt_stream.get str_stream with | |
60 | + | Some str -> ( | |
61 | + match String.split str ~on:' ' with | |
62 | + | [ time_str; key_str ] -> | |
63 | + Lwt.return (Some (Float.of_string time_str, key_str)) | |
64 | + | _ -> failwith "Invalid output from Python keypress server") | |
65 | + | None -> Lwt.return None) | |
65 | 66 | in |
66 | 67 | |
67 | - Lwt.return stream | |
\ No newline at end of file | ||
68 | + Lwt.return stream |
@@ -4,34 +4,24 @@ open Core | ||
4 | 4 | type split = { |
5 | 5 | title : string; |
6 | 6 | time : Duration.t; |
7 | - is_gold : bool [@default false]; | |
7 | + is_gold : bool; [@default false] | |
8 | 8 | } |
9 | 9 | [@@deriving sexp] |
10 | 10 | |
11 | 11 | (* A gold split. *) |
12 | -type gold = { | |
13 | - title : string; | |
14 | - duration : Duration.t; | |
15 | -} | |
16 | -[@@deriving sexp] | |
17 | - | |
18 | -type archived_run = { | |
19 | - attempt : int; | |
20 | - splits : split array; | |
21 | -} | |
22 | -[@@deriving sexp] | |
12 | +type gold = { title : string; duration : Duration.t } [@@deriving sexp] | |
13 | +type archived_run = { attempt : int; splits : split array } [@@deriving sexp] | |
23 | 14 | |
24 | 15 | type game = { |
25 | 16 | title : string; |
26 | 17 | category : string; |
27 | 18 | attempts : int; |
28 | 19 | completed : int; |
29 | - | |
30 | 20 | split_names : string array; |
31 | - golds : gold array [@sexp.omit_nil]; | |
32 | - personal_best : archived_run option [@sexp.option]; | |
33 | - world_record : archived_run option [@sexp.option]; | |
34 | - history : archived_run list [@sexp.omit_nil]; | |
21 | + golds : gold array; [@sexp.omit_nil] | |
22 | + personal_best : archived_run option; [@sexp.option] | |
23 | + world_record : archived_run option; [@sexp.option] | |
24 | + history : archived_run list; [@sexp.omit_nil] | |
35 | 25 | } |
36 | 26 | [@@deriving sexp] |
37 | 27 |
@@ -40,56 +30,52 @@ let game_of_sexp sexp = | ||
40 | 30 | let num_splits = Array.length game.split_names in |
41 | 31 | if num_splits = 0 then of_sexp_error "No split names defined" sexp |
42 | 32 | else |
43 | - | |
44 | 33 | let check_run run name = |
45 | - let pb_ok = match run with | |
34 | + let pb_ok = | |
35 | + match run with | |
46 | 36 | | Some r -> Array.length r.splits = num_splits |
47 | 37 | | None -> true |
48 | 38 | in |
49 | - if not pb_ok | |
50 | - then of_sexp_error (name ^ " has different number of splits than split_names") sexp | |
39 | + if not pb_ok then | |
40 | + of_sexp_error | |
41 | + (name ^ " has different number of splits than split_names") | |
42 | + sexp | |
51 | 43 | else () |
52 | 44 | in |
53 | 45 | |
54 | 46 | check_run game.personal_best "Personal best"; |
55 | 47 | check_run game.world_record "World record"; |
56 | 48 | |
57 | - let history_runs_ok = List.fold game.history ~init:true ~f:( | |
58 | - fun all_ok run -> all_ok && Array.length run.splits = num_splits | |
59 | - ) | |
49 | + let history_runs_ok = | |
50 | + List.fold game.history ~init:true ~f:(fun all_ok run -> | |
51 | + all_ok && Array.length run.splits = num_splits) | |
60 | 52 | in |
61 | - if not history_runs_ok | |
62 | - then of_sexp_error "Not all history runs have same number of splits as split_names" sexp | |
53 | + if not history_runs_ok then | |
54 | + of_sexp_error | |
55 | + "Not all history runs have same number of splits as split_names" sexp | |
63 | 56 | else game |
64 | 57 | |
65 | 58 | let load_golds parsed_game = |
66 | - if Int.equal (Array.length parsed_game.golds) 0 then | |
59 | + if Int.equal (Array.length parsed_game.golds) 0 then | |
67 | 60 | Array.map parsed_game.split_names ~f:(fun name -> |
68 | - {Timer_types.title = name; duration = None} | |
69 | - ) | |
70 | - else | |
61 | + { Timer_types.title = name; duration = None }) | |
62 | + else | |
71 | 63 | Array.map parsed_game.golds ~f:(fun seg -> |
72 | - { | |
73 | - Timer_types.title = seg.title; | |
74 | - duration = Some seg.duration; | |
75 | - } | |
76 | - ) | |
64 | + { Timer_types.title = seg.title; duration = Some seg.duration }) | |
77 | 65 | |
78 | 66 | let load_run parsed_run = |
79 | - let splits = Array.map parsed_run.splits ~f:(fun split -> | |
80 | - { | |
81 | - Timer_types.title = split.title; | |
82 | - time = Some split.time; | |
83 | - is_gold = split.is_gold; | |
84 | - } | |
85 | - ) | |
67 | + let splits = | |
68 | + Array.map parsed_run.splits ~f:(fun split -> | |
69 | + { | |
70 | + Timer_types.title = split.title; | |
71 | + time = Some split.time; | |
72 | + is_gold = split.is_gold; | |
73 | + }) | |
86 | 74 | in |
87 | 75 | |
88 | - {Timer_types.attempt = parsed_run.attempt; splits = splits} | |
76 | + { Timer_types.attempt = parsed_run.attempt; splits } | |
89 | 77 | |
90 | -let load_run_opt = function | |
91 | - | Some run -> Some (load_run run) | |
92 | - | None -> None | |
78 | +let load_run_opt = function Some run -> Some (load_run run) | None -> None | |
93 | 79 | |
94 | 80 | let load filepath = |
95 | 81 | let game = Sexp.load_sexp_conv_exn filepath game_of_sexp in |
@@ -103,46 +89,38 @@ let load filepath = | ||
103 | 89 | category = game.category; |
104 | 90 | attempts = game.attempts; |
105 | 91 | completed = game.completed; |
106 | - | |
107 | 92 | split_names = game.split_names; |
108 | - golds = golds; | |
109 | - history = history; | |
110 | - | |
93 | + golds; | |
94 | + history; | |
111 | 95 | comparison = pb; |
112 | - pb = pb; | |
113 | - wr = wr; | |
96 | + pb; | |
97 | + wr; | |
114 | 98 | state = Idle; |
115 | - | |
116 | 99 | splits_file = filepath; |
117 | 100 | } |
118 | 101 | |
119 | -let export_run (run : Timer_types.archived_run) = | |
102 | +let export_run (run : Timer_types.archived_run) = | |
120 | 103 | { |
121 | 104 | attempt = run.attempt; |
122 | - splits = Array.map run.splits ~f:(fun split -> | |
123 | - { | |
124 | - title = split.title; | |
125 | - time = ( | |
126 | - match split.time with | |
127 | - | Some t -> t | |
128 | - | None -> assert false | |
129 | - ); | |
130 | - is_gold = split.is_gold; | |
131 | - } | |
132 | - ); | |
133 | - } | |
105 | + splits = | |
106 | + Array.map run.splits ~f:(fun split -> | |
107 | + { | |
108 | + title = split.title; | |
109 | + time = (match split.time with Some t -> t | None -> assert false); | |
110 | + is_gold = split.is_gold; | |
111 | + }); | |
112 | + } | |
134 | 113 | |
135 | -let map_run_opt = function | |
136 | - | Some run -> Some (export_run run) | |
137 | - | None -> None | |
114 | +let map_run_opt = function Some run -> Some (export_run run) | None -> None | |
138 | 115 | |
139 | 116 | let save (timer : Timer_types.timer) = |
140 | 117 | let map_gold (gold : Timer_types.gold) = |
141 | 118 | { |
142 | 119 | title = gold.title; |
143 | - duration = match gold.duration with | |
120 | + duration = | |
121 | + (match gold.duration with | |
144 | 122 | | Some duration -> duration |
145 | - | None -> assert false; | |
123 | + | None -> assert false); | |
146 | 124 | } |
147 | 125 | in |
148 | 126 |
@@ -151,18 +129,19 @@ let save (timer : Timer_types.timer) = | ||
151 | 129 | |
152 | 130 | let history = List.map timer.history ~f:export_run in |
153 | 131 | |
154 | - let game = { | |
155 | - title = timer.title; | |
156 | - category = timer.category; | |
157 | - attempts = timer.attempts; | |
158 | - completed = timer.completed; | |
159 | - | |
160 | - split_names = timer.split_names; | |
161 | - golds = Array.map timer.golds ~f:map_gold; | |
162 | - history = history; | |
163 | - personal_best = pb; | |
164 | - world_record = wr; | |
165 | - } in | |
132 | + let game = | |
133 | + { | |
134 | + title = timer.title; | |
135 | + category = timer.category; | |
136 | + attempts = timer.attempts; | |
137 | + completed = timer.completed; | |
138 | + split_names = timer.split_names; | |
139 | + golds = Array.map timer.golds ~f:map_gold; | |
140 | + history; | |
141 | + personal_best = pb; | |
142 | + world_record = wr; | |
143 | + } | |
144 | + in | |
166 | 145 | |
167 | 146 | let sexp = sexp_of_game game in |
168 | 147 | let sexp_string = Sexp_pretty.sexp_to_string sexp in |
@@ -2,23 +2,24 @@ open Core | ||
2 | 2 | open Timer_types |
3 | 3 | |
4 | 4 | let split_time timer ?now split_num = |
5 | - if split_num < 0 then Some 0 else | |
6 | - let curr_time = match now with Some t -> t | None -> Core_unix.gettimeofday () in | |
5 | + if split_num < 0 then Some 0 | |
6 | + else | |
7 | + let curr_time = | |
8 | + match now with Some t -> t | None -> Core_unix.gettimeofday () | |
9 | + in | |
7 | 10 | |
8 | 11 | match timer.state with |
9 | 12 | | Idle -> None |
10 | - | |
11 | 13 | | Paused (splits, start_time, pause_time) -> |
12 | - if split_num > Array.length splits then None | |
13 | - else if split_num = Array.length splits | |
14 | - then Some (Duration.between start_time pause_time) | |
15 | - else splits.(split_num) | |
16 | - | |
14 | + if split_num > Array.length splits then None | |
15 | + else if split_num = Array.length splits then | |
16 | + Some (Duration.between start_time pause_time) | |
17 | + else splits.(split_num) | |
17 | 18 | | Timing (splits, start_time) | Done (splits, start_time) -> |
18 | - if split_num > Array.length splits then None | |
19 | - else if split_num = Array.length splits | |
20 | - then Some (Duration.between start_time curr_time) | |
21 | - else splits.(split_num) | |
19 | + if split_num > Array.length splits then None | |
20 | + else if split_num = Array.length splits then | |
21 | + Some (Duration.between start_time curr_time) | |
22 | + else splits.(split_num) | |
22 | 23 | |
23 | 24 | let duration timer = |
24 | 25 | match timer.state with |
@@ -26,18 +27,19 @@ let duration timer = | ||
26 | 27 | | Timing (splits, _) | Paused (splits, _, _) | Done (splits, _) -> ( |
27 | 28 | match split_time timer (Array.length splits) with |
28 | 29 | | Some t -> t |
29 | - | None -> assert false | |
30 | - ) | |
30 | + | None -> assert false) | |
31 | 31 | |
32 | 32 | let ahead_by timer ?now split_num = |
33 | - if split_num < 0 then None else | |
33 | + if split_num < 0 then None | |
34 | + else | |
34 | 35 | let split_time = split_time timer ?now split_num in |
35 | - let comp_time = match timer.comparison with | |
36 | + let comp_time = | |
37 | + match timer.comparison with | |
36 | 38 | | None -> None |
37 | 39 | | Some comp -> comp.splits.(split_num).time |
38 | 40 | in |
39 | 41 | |
40 | - match split_time, comp_time with | |
42 | + match (split_time, comp_time) with | |
41 | 43 | | Some st, Some ct -> Some (st - ct) |
42 | 44 | | _ -> None |
43 | 45 |
@@ -45,60 +47,57 @@ let segment_time timer ?now split_num = | ||
45 | 47 | let t0 = split_time timer ?now (split_num - 1) in |
46 | 48 | let t1 = split_time timer ?now split_num in |
47 | 49 | |
48 | - match t0, t1 with | |
49 | - | Some t0', Some t1' -> Some (t1' - t0') | |
50 | - | _ -> None | |
50 | + match (t0, t1) with Some t0', Some t1' -> Some (t1' - t0') | _ -> None | |
51 | 51 | |
52 | 52 | let current_split timer = |
53 | 53 | match timer.state with |
54 | 54 | | Idle -> None |
55 | 55 | | Timing (splits, _) | Paused (splits, _, _) | Done (splits, _) -> |
56 | - Some (Array.length splits) | |
56 | + Some (Array.length splits) | |
57 | 57 | |
58 | 58 | let is_gold timer split_num = |
59 | - match current_split timer, segment_time timer split_num with | |
59 | + match (current_split timer, segment_time timer split_num) with | |
60 | 60 | | Some n, Some seg_time -> ( |
61 | - if split_num >= n then false else | |
61 | + if split_num >= n then false | |
62 | + else | |
62 | 63 | match timer.golds.(split_num).duration with |
63 | 64 | | Some duration -> seg_time < duration |
64 | - | None -> true | |
65 | - ) | |
65 | + | None -> true) | |
66 | 66 | | _ -> false |
67 | 67 | |
68 | 68 | let updated_golds timer = |
69 | 69 | match timer.state with |
70 | 70 | | Idle -> timer.golds |
71 | 71 | | Timing (splits, _) | Paused (splits, _, _) | Done (splits, _) -> |
72 | - let seg_durations = Array.mapi splits ~f:(fun i _ -> | |
73 | - segment_time timer i | |
74 | - ) in | |
75 | - let old_durations = Array.map timer.golds ~f:(fun g -> g.duration) in | |
76 | - | |
77 | - let new_durations = Array.mapi timer.split_names ~f:(fun i _ -> | |
78 | - if i >= Array.length splits | |
79 | - then old_durations.(i) | |
80 | - else | |
81 | - match seg_durations.(i), old_durations.(i) with | |
82 | - | Some n, Some o -> if n < o then Some n else Some o | |
83 | - | Some n, None -> Some n | |
84 | - | None, Some o -> Some o | |
85 | - | None, None -> None | |
86 | - ) in | |
87 | - | |
88 | - Array.map2_exn timer.split_names new_durations ~f:(fun name dur -> | |
89 | - {title = name; duration = dur} | |
90 | - ) | |
72 | + let seg_durations = | |
73 | + Array.mapi splits ~f:(fun i _ -> segment_time timer i) | |
74 | + in | |
75 | + let old_durations = Array.map timer.golds ~f:(fun g -> g.duration) in | |
76 | + | |
77 | + let new_durations = | |
78 | + Array.mapi timer.split_names ~f:(fun i _ -> | |
79 | + if i >= Array.length splits then old_durations.(i) | |
80 | + else | |
81 | + match (seg_durations.(i), old_durations.(i)) with | |
82 | + | Some n, Some o -> if n < o then Some n else Some o | |
83 | + | Some n, None -> Some n | |
84 | + | None, Some o -> Some o | |
85 | + | None, None -> None) | |
86 | + in | |
87 | + | |
88 | + Array.map2_exn timer.split_names new_durations ~f:(fun name dur -> | |
89 | + { title = name; duration = dur }) | |
91 | 90 | |
92 | 91 | let gold_sum timer start bound = |
93 | 92 | let gold_array = Array.slice (updated_golds timer) start bound in |
94 | 93 | Array.fold gold_array ~init:(Some 0) ~f:(fun sum gold -> |
95 | - match sum, gold.duration with | |
94 | + match (sum, gold.duration) with | |
96 | 95 | | Some x, Some y -> Some (x + y) |
97 | - | _ -> None | |
98 | - ) | |
96 | + | _ -> None) | |
99 | 97 | |
100 | 98 | let archived_split_time run split_num = |
101 | - if split_num < 0 then Some 0 else | |
99 | + if split_num < 0 then Some 0 | |
100 | + else | |
102 | 101 | match run.comparison with |
103 | 102 | | Some comp -> comp.splits.(split_num).time |
104 | 103 | | None -> None |
@@ -106,23 +105,15 @@ let archived_split_time run split_num = | ||
106 | 105 | let archived_segment_time run split_num = |
107 | 106 | let t0 = archived_split_time run (split_num - 1) in |
108 | 107 | let t1 = archived_split_time run split_num in |
109 | - match t0, t1 with | |
110 | - | Some t0', Some t1' -> Some (t1' - t0') | |
111 | - | _ -> None | |
108 | + match (t0, t1) with Some t0', Some t1' -> Some (t1' - t0') | _ -> None | |
112 | 109 | |
113 | 110 | let archive_done_run timer splits = |
114 | - let run_splits = Array.mapi timer.split_names ~f:(fun i name -> | |
115 | - { | |
116 | - title = name; | |
117 | - time = splits.(i); | |
118 | - is_gold = is_gold timer i; | |
119 | - } | |
120 | - ) in | |
121 | - | |
122 | - { | |
123 | - attempt = timer.attempts; | |
124 | - splits = run_splits; | |
125 | - } | |
111 | + let run_splits = | |
112 | + Array.mapi timer.split_names ~f:(fun i name -> | |
113 | + { title = name; time = splits.(i); is_gold = is_gold timer i }) | |
114 | + in | |
115 | + | |
116 | + { attempt = timer.attempts; splits = run_splits } | |
126 | 117 | |
127 | 118 | let updated_pb timer = |
128 | 119 | match timer.state with |
@@ -132,9 +123,8 @@ let updated_pb timer = | ||
132 | 123 | | None -> None |
133 | 124 | | Some pb_run -> ( |
134 | 125 | let last_idx = Array.length splits - 1 in |
135 | - match splits.(last_idx), pb_run.splits.(last_idx).time with | |
136 | - | Some new_t, Some old_t -> | |
137 | - if new_t < old_t then Some (archive_done_run timer splits) else timer.pb | |
138 | - | _ -> None | |
139 | - ) | |
140 | - ) | |
\ No newline at end of file | ||
126 | + match (splits.(last_idx), pb_run.splits.(last_idx).time) with | |
127 | + | Some new_t, Some old_t -> | |
128 | + if new_t < old_t then Some (archive_done_run timer splits) | |
129 | + else timer.pb | |
130 | + | _ -> None)) |
@@ -1,25 +1,13 @@ | ||
1 | -type split = { | |
2 | - title : string; | |
3 | - time : Duration.t option; | |
4 | - is_gold: bool; | |
5 | -} | |
6 | - | |
7 | -type gold = { | |
8 | - title : string; | |
9 | - duration : Duration.t option; | |
10 | -} | |
11 | - | |
12 | -type archived_run = { | |
13 | - attempt : int; | |
14 | - splits : split array; | |
15 | -} | |
16 | - | |
1 | +type split = { title : string; time : Duration.t option; is_gold : bool } | |
2 | +type gold = { title : string; duration : Duration.t option } | |
3 | +type archived_run = { attempt : int; splits : split array } | |
17 | 4 | type live_splits = Duration.t option array |
18 | 5 | |
19 | -type timer_state = | |
6 | +type timer_state = | |
20 | 7 | | Idle |
21 | 8 | | Timing of live_splits * float (* splits * start time *) |
22 | - | Paused of live_splits * float * float (* splits * start time * paused time *) | |
9 | + | Paused of | |
10 | + live_splits * float * float (* splits * start time * paused time *) | |
23 | 11 | | Done of live_splits * float (* completed splits * start time *) |
24 | 12 | |
25 | 13 | (* Most of timer state is bundled together in this single package. |
@@ -30,15 +18,12 @@ type timer = { | ||
30 | 18 | category : string; |
31 | 19 | attempts : int; |
32 | 20 | completed : int; |
33 | - | |
34 | 21 | split_names : string array; |
35 | 22 | golds : gold array; |
36 | 23 | history : archived_run list; |
37 | 24 | comparison : archived_run option; |
38 | 25 | pb : archived_run option; |
39 | 26 | wr : archived_run option; |
40 | - | |
41 | 27 | state : timer_state; |
42 | - | |
43 | 28 | splits_file : string; |
44 | -} | |
\ No newline at end of file | ||
29 | +} |