Source file g.ml

(*********************************************************************************)
(*                OCaml-Stk                                                      *)
(*                                                                               *)
(*    Copyright (C) 2023-2024 INRIA All rights reserved.                         *)
(*    Author: Maxence Guesdon, INRIA Saclay                                      *)
(*                                                                               *)
(*    This program is free software; you can redistribute it and/or modify       *)
(*    it under the terms of the GNU General Public License as                    *)
(*    published by the Free Software Foundation, version 3 of the License.       *)
(*                                                                               *)
(*    This program is distributed in the hope that it will be useful,            *)
(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the               *)
(*    GNU General Public License for more details.                               *)
(*                                                                               *)
(*    You should have received a copy of the GNU General Public                  *)
(*    License along with this program; if not, write to the Free Software        *)
(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
(*    02111-1307  USA                                                            *)
(*                                                                               *)
(*    As a special exception, you have permission to link this program           *)
(*    with the OCaml compiler and distribute executables, as long as you         *)
(*    follow the requirements of the GNU GPL in regard to all of the             *)
(*    software in the executable aside from the OCaml compiler.                  *)
(*                                                                               *)
(*    Contact: Maxence.Guesdon@inria.fr                                          *)
(*                                                                               *)
(*********************************************************************************)

(** Geometry.

This module is used to represent and compute widget coordinates.

*)

(** A geometry is rectangle. [x] and [y] are coordinates of top-left corner.*)
type t = { x: int ;
    y: int ;
    w: int (** width *) ;
    h: int (** height *) }

let to_string g = Printf.sprintf "{x=%d; y=%d; w=%d; h=%d}" g.x g.y g.w g.h
let pp ppf g = Format.fprintf ppf  "{x=%d; y=%d; w=%d; h=%d}" g.x g.y g.w g.h

(** Convenient function to create a {!type-t}. *)
let create ~x ~y ~w ~h = { x ; y ; w ; h }

(** [seg_inter x1 w1 x2 w2] returns the intersection segment (left..right)
     between segments [(x1..(x1+w1))] and [(x2..(x2+w2))], if any. *)
let seg_inter x1 w1 x2 w2 =
  let (xl, wl, xr, wr) = if x1 <= x2 then (x1,w1,x2,w2) else (x2,w2,x1,w1) in
  if xl + wl <= xr then
    None
  else
    let x = xr in
    let w = (min (xl + wl) (xr + wr)) - x in
    Some (x, w)

(** Intersection between two rectangles, if any. *)
let inter g1 g2 =
  match seg_inter g1.x g1.w g2.x g2.w with
  | None -> None
  | Some (x,w) ->
      match seg_inter g1.y g1.h g2.y g2.h with
      | None -> None
      | Some (y,h) -> Some { x ; y ; w ; h }

(** Union of two rectangles, i.e. returns the rectangle containing both. *)
let union g1 g2 =
  let x = min g1.x g2.x in
  let y = min g1.y g2.y in
  let x2 = max (g1.x + g1.w) (g2.x + g2.w) in
  let y2 = max (g1.y + g1.h) (g2.y + g2.h) in
  { x ; y ; w = x2 - x; h = y2 - y }

(** Zero geometry, all fields set to [0]. *)
let zero = { x = 0 ; y = 0 ; w = 0; h = 0 }
let is_zero g = g = zero

(** [inside ~x ~y g] returns [true] is point [(x, y)] is inside [g]. *)
let inside ~x ~y g =
  g.x <= x && x <= g.x + g.w - 1 &&
  g.y <= y && y <= g.y + g.h - 1

(** [translate ~x ~y g] returns a new geometry, adding [x] (resp. [y]) to
  [g.x] (resp. [g.y]) if specified. *)
let translate ?x ?y g =
  { g with
    x = Option.fold ~none:g.x ~some:((+) g.x) x ;
    y = Option.fold ~none:g.y ~some:((+) g.y) y ;
  }

(** [enlarge ~w ~h g] returns a new geometry whose width (resp. height)
  is increased by [2 * w] (resp. [2 * h]). [g.x] (resp. [g.y]) is
  translated by [-w] (resp. [-h]) so that the final geometry remains
  centered with report to the original one.*)
let enlarge ?w ?h g =
  let (x, w) = match w with
    | None -> g.x, g.w
    | Some n -> g.x - n, g.w + 2 * n
  in
  let (y, h) = match h with
    | None -> g.y, g.h
    | Some n -> g.y - n, g.h + 2 * n
  in
  { x ; y ; w ; h }

(** [to_rect g] creates a {!Tsdl.Sdl.rect} from [g]. *)
let to_rect g = Tsdl.Sdl.Rect.create ~x:g.x ~y:g.y ~w:g.w ~h:g.h

(** [of_rect r] creates a geometry {!type-t} from a {!Tsdl.Sdl.rect}. *)
let of_rect r =
  let module R = Tsdl.Sdl.Rect in
  { x = R.x r ; y = R.y r; w = R.w r; h = R.h r }

let pp_rect ppf r =
  let module R = Tsdl.Sdl.Rect in
  Format.fprintf ppf "{x=%d; y=%d; w=%d; h=%d}"
  (R.x r) (R.y r) (R.w r) (R.h r)

(** [has_intersect g1 g2] returns [true] if [intersection g1 g2 <> None]. *)
let has_intersect g1 g2 = inter g1 g2 <> None

(** [remove_border g borders] returns a new geometry by removing borders
  from [g]. It is ensured that the returned geometry has non-negative
  width and height.
*)
let remove_border r trbl =
  let x = r.x + min r.w trbl.Props.left in
  let y = r.y + min r.h trbl.top in
  let w = max 0 (r.w - trbl.left - trbl.right) in
  let h = max 0 (r.h - trbl.top - trbl.bottom) in
  { x ; y ; w ; h }