diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/marker.ml | 36 | ||||
-rw-r--r-- | src/utils.ml | 36 |
2 files changed, 72 insertions, 0 deletions
diff --git a/src/marker.ml b/src/marker.ml new file mode 100644 index 0000000..19b1be0 --- /dev/null +++ b/src/marker.ml | |||
@@ -0,0 +1,36 @@ | |||
1 | module type Marker = sig | ||
2 | type t | ||
3 | val of_string : string -> t | ||
4 | val pp : out_channel -> t -> unit | ||
5 | end | ||
6 | |||
7 | module Marker = struct | ||
8 | type t = Point | ||
9 | | Pixel | ||
10 | | Circle | ||
11 | | TriangleDown | ||
12 | | TriangleUp | ||
13 | | TriangleLeft | ||
14 | | TriangleRight | ||
15 | | Custom of string | ||
16 | |||
17 | exception Invalid_marker_length | ||
18 | let of_string s = | ||
19 | if String.length s <> 1 | ||
20 | then raise Invalid_marker_length | ||
21 | else Custom(s) | ||
22 | |||
23 | let pp channel n = | ||
24 | (match n with | ||
25 | | Point -> "." | ||
26 | | Pixel -> "," | ||
27 | | Circle -> "o" | ||
28 | | TriangleDown -> "v" | ||
29 | | TriangleUp -> "^" | ||
30 | | TriangleLeft -> ">" | ||
31 | | TriangleRight -> "<" | ||
32 | | Custom(s) -> s) | ||
33 | |> Printf.fprintf channel "%s" | ||
34 | |||
35 | end | ||
36 | |||
diff --git a/src/utils.ml b/src/utils.ml new file mode 100644 index 0000000..8d1094e --- /dev/null +++ b/src/utils.ml | |||
@@ -0,0 +1,36 @@ | |||
1 | module Utils = struct | ||
2 | exception Empty_list | ||
3 | let fold fn = function | ||
4 | | [] -> raise Empty_list | ||
5 | | head :: tail -> List.fold_left fn head tail | ||
6 | |||
7 | let list_min ls = fold Stdlib.min ls | ||
8 | let list_max ls = fold Stdlib.max ls | ||
9 | |||
10 | let rec repeat n a = | ||
11 | if n <= 0 | ||
12 | then [] | ||
13 | else a :: repeat (n - 1) a | ||
14 | |||
15 | let empty ls = (ls = []) | ||
16 | |||
17 | let rec zip l1 l2 = | ||
18 | match (l1, l2) with | ||
19 | | ([], _) -> [] | ||
20 | | (_, []) -> [] | ||
21 | | (h1 :: t1, h2 :: t2) -> (h1, h2) :: zip t1 t2 | ||
22 | |||
23 | let rec transpose = function | ||
24 | | [] :: _ -> [] | ||
25 | | ls -> List.(map hd ls) :: transpose List.(map tl ls) | ||
26 | |||
27 | let flip f a b = f b a | ||
28 | |||
29 | let rot_right ls = List.(rev ls |> transpose) | ||
30 | let rot_left ls = List.(transpose ls |> rev) | ||
31 | |||
32 | let saturating_sub b a = | ||
33 | if a < b then 0 | ||
34 | else a - b | ||
35 | end | ||
36 | |||