Source file Render.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
(* Claude Code
 *
 * Copyright (C) 2026 Yoann Padioleau
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Library General Public License
 * (LGPL) as published by the Free Software Foundation; either version
 * 2 of the License, or (at your option) any later version.
 *)

(* See Render.mli *)

type paint = Color of int | Texture of Texture.image
type face = { paint : paint; points : (Vec3.t * (float * float) * Vec3.t) list; material : Material.t }
type visibility = Z_buffer | Painters_algorithm

type options = {
  shading : Shading.mode;
  interpolation : Interpolate.mode;
  visibility : visibility;
  wireframe : bool;
  backface_culling : bool;
  bilinear : bool;
  clipping : bool;
  fill_rule : Triangle.fill_rule;
}

let default_options =
  {
    shading = Shading.Phong;
    interpolation = Interpolate.Perspective_correct;
    visibility = Z_buffer;
    wireframe = false;
    backface_culling = true;
    bilinear = true;
    clipping = true;
    fill_rule = Triangle.Epsilon;
  }

(*****************************************************************************)
(* Colors *)
(*****************************************************************************)

let scale_channel (c : int) (brightness : float) : int = int_of_float (float_of_int c *. brightness)

(* the [color] closure for a face, resolving a pixel's final 0xRRGGBB
 * color from its interpolated (u, v) and its brightness: a constant
 * closure for a flat-colored face, a texture sample for a textured one.
 * Computed once per face, not once per pixel, except for the actual
 * texture sampling (genuinely per-pixel, since the color varies across
 * the face) and the [brightness] scaling (genuinely per-pixel too, for
 * Gouraud/Phong -- see Shading, which is what actually computes it;
 * this function doesn't know or care which shading mode produced it). *)
let color_of_paint (options : options) (paint : paint) : u:float -> v:float -> brightness:float -> int =
  let shade (r, g, b) ~brightness : int =
    (scale_channel r brightness lsl 16) lor (scale_channel g brightness lsl 8) lor scale_channel b brightness
  in
  match paint with
  | Color rgb ->
      let (r, g, b) = ((rgb lsr 16) land 0xFF, (rgb lsr 8) land 0xFF, rgb land 0xFF) in
      fun ~u:_ ~v:_ ~brightness -> shade (r, g, b) ~brightness
  | Texture img ->
      let sample = if options.bilinear then Texture.sample_bilinear else Texture.sample_nearest in
      fun ~u ~v ~brightness -> shade (sample img ~u ~v) ~brightness

(*****************************************************************************)
(* The pipeline *)
(*****************************************************************************)

(* fan-triangulate a (convex, e.g. a cube face or a plane) polygon:
 * (p0,p1,p2), (p0,p2,p3), (p0,p3,p4), ... *)
let rec fan_triangles = function
  | p0 :: p1 :: p2 :: rest -> (p0, p1, p2) :: fan_triangles (p0 :: p2 :: rest)
  | _ -> []

let points_of (face : face) : Vec3.t list = List.map (fun (p, _uv, _n) -> p) face.points

let render ?(options = default_options) (fb : Framebuffer.t) (zbuffer : Zbuffer.t) (camera : Camera.t)
    (faces : face list) : unit =
  (* claude: only in Painters_algorithm mode -- Triangle.fill without a
   * z-buffer has no per-pixel depth test at all, so *draw order* is the
   * only thing that determines what ends up on top; sorting faces
   * farthest-from-the-camera-first here, so nearer faces are drawn
   * later and end up covering farther ones, is what makes that mode
   * look right at all (still not correct for intersecting/cyclically-
   * overlapping geometry -- see Painter.mli). The z-buffer mode needs
   * no such sort: its per-pixel depth test makes the result correct
   * regardless of draw order. *)
  let faces, zbuffer =
    match options.visibility with
    | Z_buffer ->
        Zbuffer.clear zbuffer;
        (faces, Some zbuffer)
    | Painters_algorithm -> (Painter.sort_far_to_near ~eye:camera.eye points_of faces, None)
  in
  faces
  |> List.iter (fun (face : face) ->
         if (not options.backface_culling) || Cull.faces_camera ~eye:camera.eye (points_of face) then begin
           let color = color_of_paint options face.paint in
           let project = Project.vertex camera ~width:fb.width ~height:fb.height in
           let projected =
             fan_triangles face.points
             |> List.concat_map (fun (pa, pb, pc) ->
                    if not options.clipping then [ (project pa, project pb, project pc) ]
                    else
                      (* claude: in view coordinates, where the near plane is
                       * simply z = near *)
                      let to_view (p, uv, n) = (Camera.view camera p, uv, n) in
                      let project = Project.vertex_of_view camera ~width:fb.width ~height:fb.height in
                      Clip.near_plane ~near:camera.near [ to_view pa; to_view pb; to_view pc ]
                      |> fan_triangles
                      |> List.map (fun (a, b, c) -> (project a, project b, project c)))
           in
           if options.wireframe then begin
             (* one representative, unlit color for the whole face
              * (sampled at the texture's center for a textured one) --
              * wireframe mode draws bare edges, not shaded pixels, so
              * brightness is always 1. here regardless of the shading
              * mode *)
             let rgb = color ~u:0.5 ~v:0.5 ~brightness:1. in
             projected
             |> List.iter (function Some v0, Some v1, Some v2 -> Triangle.outline fb ~rgb v0 v1 v2 | _ -> ())
           end
           else
             projected
             |> List.iter (function
                  | Some v0, Some v1, Some v2 ->
                      Triangle.fill fb ~fill_rule:options.fill_rule ~zbuffer ~interpolation:options.interpolation
                        ~shading:options.shading ~color v0 v1 v2
                  | _ ->
                      (* a vertex is behind the camera (or too near; only
                       * without clipping) or too far: drop the whole
                       * triangle *)
                      ())
         end)