Source file lTerm_widget_base_impl.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
87
88
89
90
91
92
93
94
95
96
97
98
99
(*
 * lTerm_widget_base_impl.ml
 * ---------------------
 * Copyright : (c) 2011, Jeremie Dimino <jeremie@dimino.org>
 * Licence   : BSD3
 *
 * This file is a part of Lambda-Term.
 *)

open LTerm_widget_callbacks
open LTerm_geom

class t initial_resource_class : object
  method children : t list
  method parent : t option
  method set_parent : t option -> unit
  method can_focus : bool
  method focus : t option LTerm_geom.directions
  method set_focus : t option LTerm_geom.directions -> unit
  method queue_draw : unit
  method set_queue_draw : (unit -> unit) -> unit
  method draw : LTerm_draw.context -> t -> unit
  method cursor_position : coord option
  method allocation : rect
  method set_allocation : rect -> unit
  method send_event : LTerm_event.t -> unit
  method on_event : ?switch : switch -> (LTerm_event.t -> bool) -> unit
  method size_request : size
  method resources : LTerm_resources.t
  method set_resources : LTerm_resources.t -> unit
  method resource_class : string
  method set_resource_class : string -> unit
  method update_resources : unit
end = object(self) 

  method children : t list = []

  method can_focus = false

  val mutable focus = LTerm_geom.({ left=None; right=None; up=None; down=None })
  method focus = focus
  method set_focus f = 
    let check = 
      function None -> () 
             | Some(x) -> 
                if not ((x : t)#can_focus) then 
                  failwith "set_focus: target widget must have can_focus=true"
    in
    check f.left; check f.right; check f.up; check f.down;
    focus <- f

  val mutable parent : t option = None
  method parent = parent
  method set_parent opt = parent <- opt

  val mutable queue_draw = ignore
  method queue_draw = queue_draw ()
  method set_queue_draw f =
    queue_draw <- f;
    List.iter (fun w -> w#set_queue_draw f) self#children

  method draw (_ : LTerm_draw.context) (_focused : t) = ()
  method cursor_position = None

  val mutable allocation = { row1 = 0; col1 = 0; row2 = 0; col2 = 0 }
  method allocation = allocation
  method set_allocation rect = allocation <- rect

  val event_filters = LTerm_widget_callbacks.create ()

  method send_event ev =
    if not (exec_filters event_filters ev) then
      match parent with
        | Some widget ->
            widget#send_event ev
        | None ->
            ()

  method on_event ?switch f = register switch event_filters f

  val size_request = { rows = 0; cols = 0 }
  method size_request = size_request

  val mutable resource_class = initial_resource_class
  method resource_class = resource_class
  method set_resource_class rc =
    resource_class <- rc;
    self#update_resources

  val mutable resources = LTerm_resources.empty
  method resources = resources
  method set_resources res =
    resources <- res;
    self#update_resources;
    List.iter (fun w -> w#set_resources res) self#children

  method update_resources = ()
end