Source file Line.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
137
138
139
(* 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 Line.mli for the algorithms, with examples *)

(*****************************************************************************)
(* Bresenham *)
(*****************************************************************************)

let bresenham (fb : Framebuffer.t) (x0, y0) (x1, y1) ~rgb ~alpha =
  let dx = abs (x1 - x0) and dy = abs (y1 - y0) in
  (* +1 or -1: which way to go *)
  let step_x = if x1 >= x0 then 1 else -1 and step_y = if y1 >= y0 then 1 else -1 in
  if dx >= dy then begin
    (* mostly horizontal: one pixel per column, like the (0, 0) -> (8, 3)
     * example in Line.mli *)
    let y = ref y0 and error = ref 0 in
    for i = 0 to dx do
      let x = x0 + (i * step_x) in
      if i > 0 then begin
        error := !error + (2 * dy);
        if !error > dx then begin
          y := !y + step_y;
          error := !error - (2 * dx)
        end
      end;
      Framebuffer.plot fb ~x ~y:!y ~rgb ~alpha
    done
  end
  else begin
    (* mostly vertical: the same, x and y swapped *)
    let x = ref x0 and error = ref 0 in
    for i = 0 to dy do
      let y = y0 + (i * step_y) in
      if i > 0 then begin
        error := !error + (2 * dx);
        if !error > dy then begin
          x := !x + step_x;
          error := !error - (2 * dy)
        end
      end;
      Framebuffer.plot fb ~x:!x ~y ~rgb ~alpha
    done
  end

(*****************************************************************************)
(* Cohen-Sutherland clipping *)
(*****************************************************************************)

let left = 1
let right = 2
let above = 4
let below = 8

let region_code ~width ~height (x, y) =
  (if x < 0. then left else if x > width then right else 0)
  lor if y < 0. then above else if y > height then below else 0

let clip ~width ~height p0 p1 =
  let code = region_code ~width ~height in
  let rec loop ((x0, y0) as p0) ((x1, y1) as p1) =
    let c0 = code p0 and c1 = code p1 in
    if c0 lor c1 = 0 then Some (p0, p1)
    else if c0 land c1 <> 0 then None
    else begin
      (* move an endpoint that is outside onto the line it's beyond;
       * the new point is on the segment, found by proportion, e.g. for
       * the line x = 0: y = y0 + (y1 - y0) * (0 - x0) / (x1 - x0) *)
      let c = if c0 <> 0 then c0 else c1 in
      let at_x x = (x, y0 +. ((y1 -. y0) *. (x -. x0) /. (x1 -. x0))) in
      let at_y y = (x0 +. ((x1 -. x0) *. (y -. y0) /. (y1 -. y0)), y) in
      let p =
        if c land left <> 0 then at_x 0.
        else if c land right <> 0 then at_x width
        else if c land above <> 0 then at_y 0.
        else at_y height
      in
      if c = c0 then loop p p1 else loop p0 p
    end
  in
  loop p0 p1

(*****************************************************************************)
(* Both *)
(*****************************************************************************)

let draw (fb : Framebuffer.t) p0 p1 ~rgb ~alpha =
  (* clip to a hair inside the right and bottom borders, so that the
   * pixel containing a clipped end is always a real one: x = width
   * exactly would be in the column just after the last *)
  let width = float fb.width -. 0.001 and height = float fb.height -. 0.001 in
  match clip ~width ~height p0 p1 with
  | None -> ()
  | Some ((x0, y0), (x1, y1)) ->
      let pixel v = int_of_float (Float.floor v) in
      bresenham fb (pixel x0, pixel y0) (pixel x1, pixel y1) ~rgb ~alpha

(*****************************************************************************)
(* Wu's antialiased lines *)
(*****************************************************************************)

let wu (fb : Framebuffer.t) (x0, y0) (x1, y1) ~rgb ~alpha =
  (* plot (a, b), with a along the line's main direction; for a mostly
   * vertical line, x and y are swapped, so swap them back *)
  let steep = Float.abs (y1 -. y0) > Float.abs (x1 -. x0) in
  let plot a b intensity =
    let x, y = if steep then (b, a) else (a, b) in
    Framebuffer.plot fb ~x ~y ~rgb ~alpha:(alpha *. intensity)
  in
  let (a0, b0), (a1, b1) = if steep then ((y0, x0), (y1, x1)) else ((x0, y0), (x1, y1)) in
  (* go left to right *)
  let (a0, b0), (a1, b1) = if a0 <= a1 then ((a0, b0), (a1, b1)) else ((a1, b1), (a0, b0)) in
  let gradient = if a1 = a0 then 0. else (b1 -. b0) /. (a1 -. a0) in
  let first = int_of_float (Float.round a0) and last = int_of_float (Float.round a1) in
  for a = first to last do
    (* where the exact line is in this column, and the two pixels it
     * passes between: floor b and floor b + 1 *)
    let b = b0 +. (gradient *. (float a -. a0)) in
    let below = Float.floor b in
    let f = b -. below in
    plot a (int_of_float below) (1. -. f);
    plot a (int_of_float below + 1) f
  done

let draw_aa (fb : Framebuffer.t) p0 p1 ~rgb ~alpha =
  let width = float fb.width -. 0.001 and height = float fb.height -. 0.001 in
  match clip ~width ~height p0 p1 with
  | None -> ()
  | Some ((x0, y0), (x1, y1)) ->
      (* pixel coordinates (centers at + 0.5) to wu's (centers at
       * integers) *)
      wu fb (x0 -. 0.5, y0 -. 0.5) (x1 -. 0.5, y1 -. 0.5) ~rgb ~alpha