rose-ash/hosts/native/lib/sx_native_paint.ml

(** Walk a positioned node tree and issue Cairo draw commands.

    Handles backgrounds with rounded corners, borders, shadows,
    and text rendering with proper font face/size/weight. *)

open Sx_native_types
open Sx_native_style

(* -- Rounded rectangle path -- *)

let rounded_rect (cr : Cairo.context) (x : float) (y : float) (w : float) (h : float) (r : float) =
  let r = Float.min r (Float.min (w /. 2.) (h /. 2.)) in
  if r <= 0. then
    Cairo.rectangle cr x y ~w ~h
  else begin
    let pi = Float.pi in
    Cairo.Path.sub cr;
    Cairo.arc cr (x +. w -. r) (y +. r) ~r ~a1:(-.pi /. 2.) ~a2:0.;
    Cairo.arc cr (x +. w -. r) (y +. h -. r) ~r ~a1:0. ~a2:(pi /. 2.);
    Cairo.arc cr (x +. r) (y +. h -. r) ~r ~a1:(pi /. 2.) ~a2:pi;
    Cairo.arc cr (x +. r) (y +. r) ~r ~a1:pi ~a2:(-.pi /. 2.);
    Cairo.Path.close cr
  end

(* -- Shadow painting -- *)

let paint_shadow (cr : Cairo.context) (b : box) (radius : float) (level : [`Sm | `Md]) =
  let (offset, blur_passes, alpha) = match level with
    | `Sm -> (1., 2, 0.04)
    | `Md -> (2., 3, 0.05)
  in
  for i = 1 to blur_passes do
    let spread = float_of_int i *. 2. in
    Cairo.save cr;
    Cairo.set_source_rgba cr 0. 0. 0. (alpha /. float_of_int i);
    rounded_rect cr
      (b.x -. spread)
      (b.y +. offset -. spread +. float_of_int i)
      (b.w +. spread *. 2.)
      (b.h +. spread *. 2.)
      (radius +. spread);
    Cairo.fill cr;
    Cairo.restore cr
  done

(* -- Main paint function -- *)

(** Paint a positioned node tree to a Cairo context. *)
let rec paint (cr : Cairo.context) (node : node) : unit =
  let s = node.style in
  let b = node.box in

  if s.display = `None then ()
  else begin
    (* Save state for potential clip *)
    Cairo.save cr;

    (* Shadow *)
    (match s.shadow with
     | `None -> ()
     | `Sm -> paint_shadow cr b s.border_radius `Sm
     | `Md -> paint_shadow cr b s.border_radius `Md);

    (* Background *)
    (match s.bg_color with
     | Some c ->
       Cairo.set_source_rgba cr c.r c.g c.b c.a;
       rounded_rect cr b.x b.y b.w b.h s.border_radius;
       Cairo.fill cr
     | None -> ());

    (* Border *)
    if s.border_width > 0. then begin
      let bc = match s.border_color with Some c -> c | None -> stone_800 in
      Cairo.set_source_rgba cr bc.r bc.g bc.b bc.a;
      Cairo.set_line_width cr s.border_width;
      rounded_rect cr
        (b.x +. s.border_width /. 2.)
        (b.y +. s.border_width /. 2.)
        (b.w -. s.border_width)
        (b.h -. s.border_width)
        (Float.max 0. (s.border_radius -. s.border_width /. 2.));
      Cairo.stroke cr
    end;

    (* Clip for overflow *)
    if s.overflow_hidden then begin
      rounded_rect cr b.x b.y b.w b.h s.border_radius;
      Cairo.clip cr
    end;

    (* Text *)
    (match node.text with
     | Some txt when String.length txt > 0 ->
       let font_name = match s.font_family with `Sans -> "sans-serif" | `Mono -> "monospace" in
       let weight = match s.font_weight with `Normal -> Cairo.Normal | `Bold -> Cairo.Bold in
       let slant = match s.font_style with `Normal -> Cairo.Upright | `Italic -> Cairo.Italic in
       Cairo.select_font_face cr ~slant ~weight font_name;
       Cairo.set_font_size cr s.font_size;
       let fe = Cairo.font_extents cr in
       Cairo.set_source_rgba cr s.text_color.r s.text_color.g s.text_color.b s.text_color.a;
       Cairo.move_to cr (b.x +. s.padding.left) (b.y +. s.padding.top +. fe.ascent);
       Cairo.show_text cr txt
     | _ -> ());

    (* Children *)
    List.iter (paint cr) node.children;

    Cairo.restore cr
  end

(** Paint a horizontal URL bar at the top of the window. *)
let paint_url_bar (cr : Cairo.context) (url : string) (width : float) : float =
  let bar_height = 36. in
  (* Bar background *)
  Cairo.set_source_rgba cr stone_100.r stone_100.g stone_100.b 1.0;
  Cairo.rectangle cr 0. 0. ~w:width ~h:bar_height;
  Cairo.fill cr;

  (* Bottom border *)
  Cairo.set_source_rgba cr stone_200.r stone_200.g stone_200.b 1.0;
  Cairo.set_line_width cr 1.;
  Cairo.move_to cr 0. bar_height;
  Cairo.line_to cr width bar_height;
  Cairo.stroke cr;

  (* URL text *)
  Cairo.select_font_face cr ~slant:Cairo.Upright ~weight:Cairo.Normal "monospace";
  Cairo.set_font_size cr 13.;
  Cairo.set_source_rgba cr stone_600.r stone_600.g stone_600.b 1.0;
  Cairo.move_to cr 12. 23.;
  Cairo.show_text cr url;

  bar_height

(** Paint the entire scene: clear, URL bar, then content. *)
let paint_scene (cr : Cairo.context) (root : node) (url : string) (width : float) (height : float) : unit =
  (* Clear to white *)
  Cairo.set_source_rgba cr 1. 1. 1. 1.;
  Cairo.rectangle cr 0. 0. ~w:width ~h:height;
  Cairo.fill cr;

  (* URL bar *)
  let bar_h = paint_url_bar cr url width in

  (* Content area *)
  Cairo.save cr;
  Cairo.rectangle cr 0. bar_h ~w:width ~h:(height -. bar_h);
  Cairo.clip cr;

  (* Offset layout by bar height *)
  root.box.y <- root.box.y +. bar_h;
  paint cr root;
  root.box.y <- root.box.y -. bar_h;  (* restore for hit testing *)

  Cairo.restore cr