package claudius

  1. Overview
  2. Docs

Source file picture.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
open Image

type t = { palette : Palette.t; pixels : int array; width : int; height : int }

let load_png_as_indexed (filepath : string) : Palette.t * int array * int * int
    =
  let img = ImageLib_unix.openfile filepath in
  let w = img.width in
  let h = img.height in

  let pixels_rgba =
    Array.init (w * h) (fun idx ->
        let x = idx mod w in
        let y = idx / w in
        match img.pixels with
        | RGB (r, g, b) ->
            let red = Pixmap.get r x y in
            let green = Pixmap.get g x y in
            let blue = Pixmap.get b x y in
            (red, green, blue, 255)
            (* 255 means fully opaque *)
        | RGBA (r, g, b, a) ->
            let red = Pixmap.get r x y in
            let green = Pixmap.get g x y in
            let blue = Pixmap.get b x y in
            let alpha = Pixmap.get a x y in
            (red, green, blue, alpha)
        | Grey p ->
            let g = Pixmap.get p x y in
            (g, g, g, 255)
        | GreyA (p, a) ->
            let g = Pixmap.get p x y in
            let alpha = Pixmap.get a x y in
            (g, g, g, alpha))
  in

  let module ColorMap = Map.Make (struct
    type t = int * int * int

    let compare = compare
  end) in
  let palette_map, palette_list, _ =
    Array.fold_left
      (fun (map, lst, idx) (r, g, b, a) ->
        if a = 0 then (map, lst, idx) (* transparent pixel *)
        else if ColorMap.mem (r, g, b) map then (map, lst, idx)
        else (ColorMap.add (r, g, b) idx map, lst @ [ (r, g, b) ], idx + 1))
      (ColorMap.empty, [], 1) (* index 0 is being used for transparency *)
      pixels_rgba
  in

  let palette_rgb_24 =
    0x000000
    :: List.map (fun (r, g, b) -> (r lsl 16) lor (g lsl 8) lor b) palette_list
  in

  let pal = Palette.of_list palette_rgb_24 in

  let indexed_pixels =
    Array.map
      (fun (r, g, b, a) ->
        if a = 0 then 0 else ColorMap.find (r, g, b) palette_map)
      pixels_rgba
  in

  (pal, indexed_pixels, w, h)

(* Public API, so real img data isn't tampered *)

let load (filepath : string) : t =
  let palette, pixels, w, h = load_png_as_indexed filepath in
  { palette; pixels; width = w; height = h }

let dimensions (pic : t) = (pic.width, pic.height)
let pixels (pic : t) = pic.pixels
let palette (pic : t) = pic.palette

let with_palette_offset (pic : t) (offset : int) : t =
  let shifted_pixels =
    Array.map (fun idx -> if idx = 0 then 0 else idx + offset) pic.pixels
  in
  { pic with pixels = shifted_pixels }