Source file `Sub.ml`

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
type 'msg onesub =  
  | SubTick of (Time.posix -> 'msg)
  | SubMouseMove of (float * float -> 'msg)
  | SubMouseDown of (unit -> 'msg)
  | SubMouseUp of (unit -> 'msg)
  | SubKeyDown of (Keyboard.key -> 'msg)
  | SubKeyUp of (Keyboard.key -> 'msg)


type 'msg t = 'msg onesub list
let none = []
let batch xs = (List.flatten xs)

(* was in Event_.ml before *)
let (on_animation_frame: (Time.posix -> 'msg) -> 'msg t) = fun f ->
  [SubTick f]

let (on_mouse_move: (float * float -> 'msg) -> 'msg t) = fun f ->
  [SubMouseMove f]

let (on_mouse_down: (unit -> 'msg) -> 'msg t) = fun f ->
  [SubMouseDown f]

let (on_mouse_up: (unit -> 'msg) -> 'msg t) = fun f ->
  [SubMouseUp f]

let (on_key_down: (Keyboard.key -> 'msg) -> 'msg t) = fun f ->
  [SubKeyDown f]

let (on_key_up: (Keyboard.key -> 'msg) -> 'msg t) = fun f ->
  [SubKeyUp f]




type event = 
  | ETick of float
  | EMouseMove of (int * int)
  | EMouseButton of bool (* is_down = true *)
  | EKeyChanged of (bool (* down = true *) * Keyboard.key)

let rec find_map_opt f = function
  | [] -> None
  | x::xs ->
      (match f x with
      | None -> find_map_opt f xs
      | Some x -> Some x
      )

let event_to_msgopt event subs =
  match event with
  | ETick time ->
      subs |> find_map_opt (function 
       | SubTick f -> Some (f time) 
       | _ -> None
      )
  | EMouseMove (x, y) ->
      subs |> find_map_opt (function 
        | SubMouseMove f ->
          Some (f (float_of_int x, float_of_int y))
         | _ -> None
      )
  | EMouseButton (true) ->
      subs |> find_map_opt (function 
        | SubMouseDown f ->
           Some (f ())
       | _ -> None
      )
  | EMouseButton (false) ->
      subs |> find_map_opt (function 
        | SubMouseUp f ->
           Some (f ())
       | _ -> None
      )
  | EKeyChanged (true, key) ->
      subs |> find_map_opt (function 
        | SubKeyDown f ->
           Some (f key)
       | _ -> None
      )
  | EKeyChanged (false, key) ->
      subs |> find_map_opt (function 
        | SubKeyUp f ->
           Some (f key)
       | _ -> None
      )