Source file `b_window.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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
(* a 'window' is in fine just a layout *)
(* Do not mistake it with a hardware (SDL) window *)
open Tsdl
open B_utils
module Layout = B_layout
module Draw = B_draw
module Chain = B_chain

type t =
  { layout : Layout.t;
    mutable is_fresh : bool;
    mutable bogue : bool;
    (* if bogue = false this means that bogue didn't create the corresponding
       SDL window, and we should neither clear it before rendering, nor
       RenderPresent it after rendering *)
    mutable on_close : (t -> unit) option (* None means destroy window *)
  }

let create ?on_close layout =
  if Layout.get_house layout <> None
  then begin
    printd (debug_error + debug_user)
      "Cannot construct a Window from room %s because it is already contained in \
       a house." (Layout.sprint_id layout);
    invalid_arg "[Window.create] Cannot create a Window from a Layout that \
                 belongs to a house."
  end else
  let g = layout.Layout.current_geom in
  Layout.(layout.current_geom <- { g with x = not_specified; y = not_specified });
  { layout; is_fresh = false; bogue = true; on_close}

let get_layout w =
  w.layout

let is_fresh w =
  w.is_fresh

let set_fresh w =
  w.is_fresh <- true

let to_refresh w =
  w.is_fresh <- false

let on_close w f =
  w.on_close <- f

(* This is not very efficient because it will search for the Window.t from the
   Layout.id... while we already have the Window.t at hand! Well, this function
   doesn't have to be efficient anyways. *)
let destroy w =
  Layout.destroy_window w.layout

let sdl_window w =
  Layout.window w.layout

let is_shown w =
  w.layout.Layout.show

let show_maybe w =
  match Layout.window_opt w.layout with
  | Some win ->
    if is_shown w
    then Sdl.show_window win
    else Sdl.hide_window win
  | None -> printd (debug_error + debug_board)
              "[Window.show_maybe] the SDL window does not exist for layout %s"
              (Layout.sprint_id w.layout)

(* physical size *)
let size w =
  Draw.get_window_size (sdl_window w)

let set_size ~w ~h win =
  do_option (Layout.window_opt win.layout) (Draw.set_window_size ~w ~h)

(* utilisé par drawin *)
let maximize_width win =
  do_option (Layout.window_opt win.layout) (fun sdl_win ->
      let id = go (Sdl.get_window_display_index sdl_win) in
      let rect = go (Sdl.get_display_bounds id) in
      let w = Sdl.Rect.w rect in
      printd debug_graphics
        "[maximize_width] Detected display size for layout %s: (%i,%i)."
        (Layout.sprint_id win.layout) w (Sdl.Rect.h rect);
      let _w, h = Draw.get_window_size sdl_win in
      Draw.set_window_size sdl_win ~w ~h)

(* untested *)
let maximize win =
  do_option (Layout.window_opt win.layout) (fun sdl_win ->
      let id = go (Sdl.get_window_display_index sdl_win) in
      let rect = go (Sdl.get_display_bounds id) in
      let w = Sdl.Rect.w rect in
      let h = Sdl.Rect.h rect in
      printd debug_graphics
        "[maximize_width] Detected display size for layout %s: (%i,%i)."
        (Layout.sprint_id win.layout) w h;
      Draw.set_window_size sdl_win ~w ~h)

let get_canvas w =
  Layout.get_canvas w.layout

(** get SDL windows id, in case the canvas was created *)
let id w =
  Sdl.get_window_id (Layout.window w.layout)

let equal w1 w2 =
  Layout.equal w1.layout w2.layout

let render w =
  Layout.render w.layout

let flip ?clear w =
  if not (is_fresh w)
  then begin
    render w;
    let clear = default clear w.bogue in
    printd debug_graphics "clear=%b" clear;
    let present = w.bogue in
    Layout.flip ~clear ~present w.layout;
    set_fresh w
  end
  else Draw.clear_layers (Layout.get_layer w.layout)

(* Span an SDL window controlled by Bogue *)
let make_sdl_window w =
  printd debug_board "Make window for layout %s (stack %d)."
    (Layout.sprint_id w.layout) (Chain.get_stack_id (Layout.get_layer w.layout));
  Layout.make_window w.layout;
  w.bogue <- true

let use_sdl_window sdl_win w =
  printd debug_board "Use existing SDL Window for layout %s."
    (Layout.sprint_id w.layout);
  Layout.make_window ~window:sdl_win w.layout;
  w.bogue <- false