My working unpac space for OCaml projects in development
Merge opam/patches/ocaml-png
+2404
+291
vendor/opam/ocaml-png/PLAN.md
+291
vendor/opam/ocaml-png/PLAN.md
···
1
+
# ocaml-png Implementation Plan
2
+
3
+
## Overview
4
+
5
+
A pure OCaml implementation of PNG encoding and decoding based on the W3C PNG Specification (Third Edition) and the high-quality Rust `image-png` reference implementation.
6
+
7
+
**Goal**: Implement a performant, correct PNG codec that passes 100% of the PNG test suite.
8
+
9
+
## Reference Materials
10
+
11
+
- `vendor/git/png/`: W3C PNG Specification (official spec)
12
+
- `vendor/git/image-png/`: Rust reference implementation (excellent architecture)
13
+
- Existing workspace libraries: `ocaml-bitstream`, `decompress` (for zlib)
14
+
15
+
## Architecture
16
+
17
+
### Module Structure
18
+
19
+
```
20
+
src/
21
+
png.ml -- Main public API and types
22
+
png.mli -- Public interface
23
+
chunk.ml -- Chunk types and parsing
24
+
filter.ml -- Row filter/unfilter algorithms
25
+
adam7.ml -- Adam7 interlacing support
26
+
crc32.ml -- CRC32 checksum (PNG uses ISO 3309)
27
+
decoder.ml -- PNG decoder implementation
28
+
encoder.ml -- PNG encoder implementation
29
+
```
30
+
31
+
### Core Types
32
+
33
+
```ocaml
34
+
(* Color types as per PNG spec section 11.2.2 *)
35
+
type color_type =
36
+
| Grayscale (* 0 - 1 sample per pixel *)
37
+
| RGB (* 2 - 3 samples per pixel *)
38
+
| Indexed (* 3 - 1 sample (palette index) *)
39
+
| Grayscale_alpha (* 4 - 2 samples per pixel *)
40
+
| RGBA (* 6 - 4 samples per pixel *)
41
+
42
+
(* Bit depths: 1, 2, 4, 8, 16 *)
43
+
type bit_depth = One | Two | Four | Eight | Sixteen
44
+
45
+
(* Image header information *)
46
+
type info = {
47
+
width : int;
48
+
height : int;
49
+
bit_depth : bit_depth;
50
+
color_type : color_type;
51
+
interlaced : bool;
52
+
palette : bytes option;
53
+
trns : bytes option;
54
+
gamma : float option;
55
+
(* ... other metadata *)
56
+
}
57
+
58
+
(* Decoded image *)
59
+
type image = {
60
+
info : info;
61
+
data : bytes; (* Row-major pixel data *)
62
+
}
63
+
```
64
+
65
+
## Implementation Phases
66
+
67
+
### Phase 1: Core Infrastructure
68
+
69
+
1. **CRC32 Module** (`crc32.ml`)
70
+
- Implement ISO 3309 polynomial CRC32
71
+
- Use lookup table for performance
72
+
- Functions: `init`, `update`, `finalize`, `compute`
73
+
74
+
2. **Chunk Module** (`chunk.ml`)
75
+
- Define chunk types (IHDR, PLTE, IDAT, IEND, tRNS, etc.)
76
+
- Chunk reader: length, type, data, CRC validation
77
+
- Chunk writer: compute and append CRC
78
+
- Critical vs ancillary chunk handling
79
+
80
+
3. **Basic Types** (`png.ml`)
81
+
- Color types with valid bit depth combinations
82
+
- Bytes per pixel calculations
83
+
- Row length calculations (including filter byte)
84
+
85
+
### Phase 2: Filter Algorithms
86
+
87
+
4. **Filter Module** (`filter.ml`)
88
+
- Implement all 5 filter types:
89
+
- None (0): No filtering
90
+
- Sub (1): Difference from left pixel
91
+
- Up (2): Difference from above pixel
92
+
- Average (3): Average of left and above
93
+
- Paeth (4): Paeth predictor
94
+
- Unfilter for decoding (in-place for efficiency)
95
+
- Filter for encoding with adaptive selection
96
+
97
+
**Key Insight from Rust impl**: Handle bytes-per-pixel (bpp) carefully:
98
+
- bpp = 1, 2, 3, 4, 6, or 8
99
+
- For sub-byte pixels, bpp for filtering is 1
100
+
- Optimize with specialized paths per bpp
101
+
102
+
### Phase 3: Decoder Implementation
103
+
104
+
5. **Decoder Module** (`decoder.ml`)
105
+
- Read and validate PNG signature
106
+
- Parse IHDR chunk (must be first)
107
+
- Stream IDAT chunks through zlib decompression
108
+
- Apply unfiltering to each row
109
+
- Handle palette expansion if needed
110
+
- Support progressive/streaming decoding
111
+
112
+
**Decoding Pipeline**:
113
+
```
114
+
IDAT chunks -> Decompress -> Unfilter -> Pixel Data
115
+
```
116
+
117
+
### Phase 4: Adam7 Interlacing
118
+
119
+
6. **Adam7 Module** (`adam7.ml`)
120
+
- Implement 7-pass interlace pattern
121
+
- Pass constants: x/y sampling and offsets
122
+
- Calculate sub-image dimensions per pass
123
+
- Expand interlaced rows to full image
124
+
- Support both sparse and splat expansion
125
+
126
+
**Pass Pattern** (1-indexed):
127
+
```
128
+
1 6 4 6 2 6 4 6
129
+
7 7 7 7 7 7 7 7
130
+
5 6 5 6 5 6 5 6
131
+
7 7 7 7 7 7 7 7
132
+
3 6 4 6 3 6 4 6
133
+
7 7 7 7 7 7 7 7
134
+
5 6 5 6 5 6 5 6
135
+
7 7 7 7 7 7 7 7
136
+
```
137
+
138
+
### Phase 5: Encoder Implementation
139
+
140
+
7. **Encoder Module** (`encoder.ml`)
141
+
- Write PNG signature
142
+
- Write IHDR with image parameters
143
+
- Optional: Write ancillary chunks (gAMA, sRGB, etc.)
144
+
- Apply filtering to each row
145
+
- Compress filtered data with zlib
146
+
- Write IDAT chunks (split at ~8KB boundaries)
147
+
- Write IEND chunk
148
+
149
+
**Encoding Pipeline**:
150
+
```
151
+
Pixel Data -> Filter -> Compress -> IDAT chunks
152
+
```
153
+
154
+
**Filter Selection Strategies**:
155
+
- Fixed: Always use a specific filter (e.g., Up for speed)
156
+
- Adaptive: Try all filters, pick minimum sum of absolute differences
157
+
- Entropy-based: Pick filter minimizing output entropy
158
+
159
+
### Phase 6: Advanced Features
160
+
161
+
8. **Transparency** (tRNS chunk)
162
+
- Grayscale: single transparent gray value
163
+
- RGB: single transparent RGB value
164
+
- Indexed: alpha values for palette entries
165
+
166
+
9. **Color Management** (ancillary chunks)
167
+
- gAMA: Gamma value
168
+
- cHRM: Chromaticities
169
+
- sRGB: sRGB color space indicator
170
+
- iCCP: ICC profile (compressed)
171
+
172
+
10. **APNG Support** (optional, future)
173
+
- Animation control (acTL)
174
+
- Frame control (fcTL)
175
+
- Frame data (fdAT)
176
+
177
+
## Performance Considerations
178
+
179
+
### Memory Efficiency
180
+
- Process rows one at a time when possible
181
+
- Reuse buffers for filtering
182
+
- Stream decompression without buffering entire IDAT
183
+
184
+
### CPU Optimization
185
+
- Specialized filter paths per bpp (avoid per-pixel conditionals)
186
+
- Use `[@inline]` for hot paths
187
+
- Consider SIMD via `ocaml-simd` for filter operations (future)
188
+
189
+
### From Rust Reference
190
+
- 32-byte chunk processing for auto-vectorization
191
+
- Bitwise average trick: `(a & b) + ((a ^ b) >> 1)`
192
+
- Paeth predictor optimization (see `filter/paeth.rs`)
193
+
194
+
## Testing Strategy
195
+
196
+
### Test Suite
197
+
1. **PNG Test Suite** (PngSuite): Standard conformance tests
198
+
- Basic formats (basn*.png, basi*.png)
199
+
- Interlaced variants
200
+
- Odd sizes
201
+
- All color type/bit depth combinations
202
+
203
+
2. **Round-trip Tests**
204
+
- Decode -> Encode -> Decode -> Compare
205
+
- Verify pixel-perfect reproduction
206
+
207
+
3. **Error Handling Tests**
208
+
- Truncated files
209
+
- Invalid CRC
210
+
- Invalid chunk ordering
211
+
- Out-of-range values
212
+
213
+
4. **Performance Benchmarks**
214
+
- Decode time vs file size
215
+
- Encode time with different compression levels
216
+
- Memory usage tracking
217
+
218
+
## Dependencies
219
+
220
+
- `decompress`: OCaml zlib implementation (already in workspace)
221
+
- `alcotest`: Testing framework
222
+
- `ocaml-bitstream`: Bit-level I/O (may use for sub-byte pixels)
223
+
224
+
## API Design
225
+
226
+
### Decoder API
227
+
```ocaml
228
+
(* Simple decode *)
229
+
val decode : bytes -> (image, error) result
230
+
val decode_file : string -> (image, error) result
231
+
232
+
(* Streaming decode *)
233
+
type decoder
234
+
val create : unit -> decoder
235
+
val read_header : decoder -> bytes -> (info, error) result
236
+
val read_row : decoder -> bytes -> (bytes option, error) result
237
+
```
238
+
239
+
### Encoder API
240
+
```ocaml
241
+
(* Simple encode *)
242
+
val encode : image -> bytes
243
+
val encode_to_file : image -> string -> unit
244
+
245
+
(* With options *)
246
+
type compression = No_compression | Fast | Default | Best
247
+
type filter_strategy = Fixed of filter | Adaptive | Min_entropy
248
+
249
+
val encode_with_options :
250
+
?compression:compression ->
251
+
?filter:filter_strategy ->
252
+
image -> bytes
253
+
```
254
+
255
+
## Milestones
256
+
257
+
1. **M1**: Decode grayscale 8-bit non-interlaced PNG
258
+
2. **M2**: Decode all color types and bit depths (non-interlaced)
259
+
3. **M3**: Decode interlaced PNGs (Adam7)
260
+
4. **M4**: Encode basic PNGs
261
+
5. **M5**: Pass full PNG test suite
262
+
6. **M6**: Performance optimization
263
+
7. **M7**: Tidy code and documentation
264
+
265
+
## Notes on PNG Specification
266
+
267
+
### Chunk Ordering Requirements
268
+
1. IHDR must be first
269
+
2. PLTE must precede IDAT (for indexed color)
270
+
3. IDAT chunks must be consecutive
271
+
4. IEND must be last
272
+
5. Ancillary chunks have specific ordering rules
273
+
274
+
### Valid Color Type / Bit Depth Combinations
275
+
| Color Type | Bit Depths |
276
+
|------------|------------|
277
+
| Grayscale (0) | 1, 2, 4, 8, 16 |
278
+
| RGB (2) | 8, 16 |
279
+
| Indexed (3) | 1, 2, 4, 8 |
280
+
| Grayscale+Alpha (4) | 8, 16 |
281
+
| RGBA (6) | 8, 16 |
282
+
283
+
### PNG Signature
284
+
```
285
+
89 50 4E 47 0D 0A 1A 0A
286
+
```
287
+
- 0x89: High bit set (detect transmission corruption)
288
+
- "PNG": ASCII identifier
289
+
- 0D 0A: DOS line ending (detect newline conversion)
290
+
- 1A: Ctrl-Z (stop DOS type command)
291
+
- 0A: Unix line ending
+68
vendor/opam/ocaml-png/STATUS.md
+68
vendor/opam/ocaml-png/STATUS.md
···
1
+
# ocaml-png Implementation Status
2
+
3
+
## Current Phase: COMPLETE
4
+
5
+
## Progress Summary
6
+
7
+
| Component | Status | Notes |
8
+
|-----------|--------|-------|
9
+
| PLAN.md | Done | Implementation plan created |
10
+
| STATUS.md | Done | This file |
11
+
| CRC32 | Done | Pure OCaml implementation |
12
+
| Chunk Types | Done | All critical and common ancillary chunks |
13
+
| Core Types | Done | Color types, bit depths, interlace |
14
+
| Filter (decode) | Done | All 5 filter types |
15
+
| Filter (encode) | Done | Adaptive filter selection |
16
+
| Adam7 | Done | Full interlace support |
17
+
| Decoder | Done | All color types, all bit depths |
18
+
| Encoder | Done | Non-interlaced encoding |
19
+
| Test Suite | Done | 323 tests passing |
20
+
21
+
## Milestones
22
+
23
+
- [x] M1: Decode grayscale 8-bit non-interlaced PNG
24
+
- [x] M2: Decode all color types and bit depths (non-interlaced)
25
+
- [x] M3: Decode interlaced PNGs (Adam7)
26
+
- [x] M4: Encode basic PNGs
27
+
- [x] M5: Pass full PNG test suite
28
+
- [x] M6: Performance optimization (using Higher API)
29
+
- [x] M7: Tidy code and documentation
30
+
31
+
## Test Suite Pass Rate
32
+
33
+
**Current**: 100% (323/323 tests passing)
34
+
35
+
- CRC32 tests: 2/2
36
+
- PNG decode tests: 175/175
37
+
- PNG roundtrip tests: 146/146
38
+
39
+
## Features
40
+
41
+
### Supported
42
+
- All color types: Grayscale, RGB, Indexed, Grayscale+Alpha, RGBA
43
+
- All bit depths: 1, 2, 4, 8, 16
44
+
- Adam7 interlacing (decode)
45
+
- All filter types: None, Sub, Up, Average, Paeth
46
+
- Ancillary chunks: gAMA, sRGB, bKGD, pHYs, tRNS, PLTE
47
+
- Adaptive filter selection for encoding
48
+
49
+
### Not Yet Supported
50
+
- Adam7 encoding (encodes as non-interlaced)
51
+
- APNG animation
52
+
- iCCP (ICC color profiles)
53
+
- Text chunks (tEXt, zTXt, iTXt)
54
+
55
+
## Blockers
56
+
57
+
None.
58
+
59
+
## Dependencies
60
+
61
+
- `decompress`: Pure OCaml zlib implementation
62
+
- `bigstringaf`: Bigstring operations
63
+
- `alcotest`: Testing framework
64
+
65
+
---
66
+
*Last updated: 2025-12-28*
67
+
*Test suite: 100% pass rate achieved!*
68
+
*Code tidied following OCaml idiomatic patterns*
+1
vendor/opam/ocaml-png/dune
+1
vendor/opam/ocaml-png/dune
···
1
+
(vendored_dirs vendor)
+19
vendor/opam/ocaml-png/ocaml-png.opam
+19
vendor/opam/ocaml-png/ocaml-png.opam
···
1
+
opam-version: "2.0"
2
+
name: "ocaml-png"
3
+
version: "0.1.0"
4
+
synopsis: "Pure OCaml PNG encoder/decoder"
5
+
description: "A pure OCaml implementation of PNG encoding and decoding"
6
+
maintainer: ["Claude"]
7
+
authors: ["Claude"]
8
+
license: "MIT"
9
+
build: [
10
+
["dune" "subst"] {dev}
11
+
["dune" "build" "-p" name "-j" jobs]
12
+
]
13
+
depends: [
14
+
"ocaml" {>= "4.14"}
15
+
"dune" {>= "3.0"}
16
+
"decompress" {>= "1.5.0"}
17
+
"bigstringaf"
18
+
"alcotest" {with-test}
19
+
]
+88
vendor/opam/ocaml-png/src/chunk.ml
+88
vendor/opam/ocaml-png/src/chunk.ml
···
1
+
(** PNG chunk types and parsing. *)
2
+
3
+
(** Chunk type as 4-byte identifier. *)
4
+
type chunk_type = int32
5
+
6
+
(** Critical chunks *)
7
+
let ihdr : chunk_type = 0x49484452l (* IHDR *)
8
+
let plte : chunk_type = 0x504C5445l (* PLTE *)
9
+
let idat : chunk_type = 0x49444154l (* IDAT *)
10
+
let iend : chunk_type = 0x49454E44l (* IEND *)
11
+
12
+
(** Ancillary chunks *)
13
+
let trns : chunk_type = 0x74524E53l (* tRNS *)
14
+
let chrm : chunk_type = 0x6348524Dl (* cHRM *)
15
+
let gama : chunk_type = 0x67414D41l (* gAMA *)
16
+
let iccp : chunk_type = 0x69434350l (* iCCP *)
17
+
let sbit : chunk_type = 0x73424954l (* sBIT *)
18
+
let srgb : chunk_type = 0x73524742l (* sRGB *)
19
+
let bkgd : chunk_type = 0x624B4744l (* bKGD *)
20
+
let hist : chunk_type = 0x68495354l (* hIST *)
21
+
let phys : chunk_type = 0x70485973l (* pHYs *)
22
+
let time : chunk_type = 0x74494D45l (* tIME *)
23
+
let text : chunk_type = 0x74455874l (* tEXt *)
24
+
let ztxt : chunk_type = 0x7A545874l (* zTXt *)
25
+
let itxt : chunk_type = 0x69545874l (* iTXt *)
26
+
let exif : chunk_type = 0x65584966l (* eXIf *)
27
+
28
+
(** APNG extension chunks *)
29
+
let actl : chunk_type = 0x6163544Cl (* acTL *)
30
+
let fctl : chunk_type = 0x6663544Cl (* fcTL *)
31
+
let fdat : chunk_type = 0x66644154l (* fdAT *)
32
+
33
+
(** Check if chunk type is critical (uppercase first letter). *)
34
+
let[@inline] is_critical (ct : chunk_type) =
35
+
Int32.(logand (shift_right_logical ct 24) 0x20l = 0l)
36
+
37
+
(** Check if chunk type is public (uppercase second letter). *)
38
+
let[@inline] is_public (ct : chunk_type) =
39
+
Int32.(logand (shift_right_logical ct 16) 0x20l = 0l)
40
+
41
+
(** Check if reserved bit is set (third letter uppercase means reserved OK). *)
42
+
let[@inline] reserved_set (ct : chunk_type) =
43
+
Int32.(logand (shift_right_logical ct 8) 0x20l <> 0l)
44
+
45
+
(** Check if chunk is safe to copy (lowercase fourth letter). *)
46
+
let[@inline] safe_to_copy (ct : chunk_type) =
47
+
Int32.(logand ct 0x20l <> 0l)
48
+
49
+
(** Convert chunk type to 4-character string. *)
50
+
let to_string (ct : chunk_type) =
51
+
let s = Bytes.create 4 in
52
+
Bytes.set s 0 (Char.chr (Int32.(to_int (logand (shift_right_logical ct 24) 0xFFl))));
53
+
Bytes.set s 1 (Char.chr (Int32.(to_int (logand (shift_right_logical ct 16) 0xFFl))));
54
+
Bytes.set s 2 (Char.chr (Int32.(to_int (logand (shift_right_logical ct 8) 0xFFl))));
55
+
Bytes.set s 3 (Char.chr (Int32.(to_int (logand ct 0xFFl))));
56
+
Bytes.to_string s
57
+
58
+
(** Convert 4-character string to chunk type. *)
59
+
let of_string s =
60
+
if String.length s <> 4 then invalid_arg "Chunk.of_string: string must be 4 chars";
61
+
let b0 = Char.code s.[0] in
62
+
let b1 = Char.code s.[1] in
63
+
let b2 = Char.code s.[2] in
64
+
let b3 = Char.code s.[3] in
65
+
Int32.(logor (logor (logor
66
+
(shift_left (of_int b0) 24)
67
+
(shift_left (of_int b1) 16))
68
+
(shift_left (of_int b2) 8))
69
+
(of_int b3))
70
+
71
+
(** Read chunk type from bytes at given position. *)
72
+
let read_type bytes ~pos =
73
+
let b0 = Bytes.get_uint8 bytes pos in
74
+
let b1 = Bytes.get_uint8 bytes (pos + 1) in
75
+
let b2 = Bytes.get_uint8 bytes (pos + 2) in
76
+
let b3 = Bytes.get_uint8 bytes (pos + 3) in
77
+
Int32.(logor (logor (logor
78
+
(shift_left (of_int b0) 24)
79
+
(shift_left (of_int b1) 16))
80
+
(shift_left (of_int b2) 8))
81
+
(of_int b3))
82
+
83
+
(** Write chunk type to bytes at given position. *)
84
+
let write_type bytes ~pos (ct : chunk_type) =
85
+
Bytes.set_uint8 bytes pos Int32.(to_int (logand (shift_right_logical ct 24) 0xFFl));
86
+
Bytes.set_uint8 bytes (pos + 1) Int32.(to_int (logand (shift_right_logical ct 16) 0xFFl));
87
+
Bytes.set_uint8 bytes (pos + 2) Int32.(to_int (logand (shift_right_logical ct 8) 0xFFl));
88
+
Bytes.set_uint8 bytes (pos + 3) Int32.(to_int (logand ct 0xFFl))
+271
vendor/opam/ocaml-png/src/chunk.mli
+271
vendor/opam/ocaml-png/src/chunk.mli
···
1
+
(** {1 PNG Chunk Types}
2
+
3
+
Chunk type definitions and utilities as specified in
4
+
{{:https://www.w3.org/TR/png/#5Chunk-layout} PNG Specification Section 5}.
5
+
6
+
{2 Overview}
7
+
8
+
A PNG file consists of a signature followed by a sequence of chunks.
9
+
Each chunk has a 4-byte type code that identifies its purpose.
10
+
The type code is encoded as four ASCII letters, stored as a 32-bit
11
+
big-endian integer.
12
+
13
+
{2 Chunk Categories}
14
+
15
+
Chunks are categorized by properties encoded in the case of their type
16
+
letters ({{:https://www.w3.org/TR/png/#5Chunk-naming-conventions}
17
+
Section 5.4}):
18
+
19
+
- {b Bit 5 of byte 0} (first letter): Critical (uppercase) vs Ancillary (lowercase)
20
+
- {b Bit 5 of byte 1} (second letter): Public (uppercase) vs Private (lowercase)
21
+
- {b Bit 5 of byte 2} (third letter): Reserved (must be uppercase)
22
+
- {b Bit 5 of byte 3} (fourth letter): Safe-to-copy (lowercase) vs Unsafe (uppercase)
23
+
24
+
{2 Chunk Ordering}
25
+
26
+
Chunk ordering requirements ({{:https://www.w3.org/TR/png/#5ChsOrdering}
27
+
Section 5.6}):
28
+
29
+
1. IHDR must be first
30
+
2. PLTE must precede IDAT (for indexed color)
31
+
3. IDAT chunks must be consecutive
32
+
4. IEND must be last
33
+
34
+
{2 References}
35
+
36
+
- {{:https://www.w3.org/TR/png/#5Chunk-layout} Section 5: Chunk Layout}
37
+
- {{:https://www.w3.org/TR/png/#11Chunks} Section 11: Chunk Specifications}
38
+
- {{:https://www.w3.org/TR/png/#5Chunk-naming-conventions} Section 5.4: Naming} *)
39
+
40
+
(** {1 Types} *)
41
+
42
+
(** Chunk type represented as a 32-bit integer.
43
+
44
+
The four ASCII characters are packed big-endian:
45
+
byte 0 in bits 24-31, byte 1 in bits 16-23, etc.
46
+
47
+
For example, "IHDR" = 0x49484452. *)
48
+
type chunk_type = int32
49
+
50
+
(** {1 Critical Chunks}
51
+
52
+
Critical chunks are essential for displaying the image.
53
+
If an unrecognized critical chunk is encountered, the decoder
54
+
must signal an error.
55
+
56
+
See {{:https://www.w3.org/TR/png/#11Critical-chunks} Section 11.2}. *)
57
+
58
+
(** Image Header chunk - must be first chunk.
59
+
60
+
Contains width, height, bit depth, color type, compression method,
61
+
filter method, and interlace method.
62
+
63
+
{{:https://www.w3.org/TR/png/#11IHDR} Section 11.2.2} *)
64
+
val ihdr : chunk_type
65
+
66
+
(** Palette chunk - required for indexed color images.
67
+
68
+
Contains 1-256 RGB entries (3 bytes each).
69
+
70
+
{{:https://www.w3.org/TR/png/#11PLTE} Section 11.2.3} *)
71
+
val plte : chunk_type
72
+
73
+
(** Image Data chunk - contains compressed pixel data.
74
+
75
+
Multiple IDAT chunks may be present and must be consecutive.
76
+
Their data is concatenated before decompression.
77
+
78
+
{{:https://www.w3.org/TR/png/#11IDAT} Section 11.2.4} *)
79
+
val idat : chunk_type
80
+
81
+
(** Image End chunk - marks end of PNG datastream.
82
+
83
+
Must be final chunk. Contains no data.
84
+
85
+
{{:https://www.w3.org/TR/png/#11IEND} Section 11.2.5} *)
86
+
val iend : chunk_type
87
+
88
+
(** {1 Ancillary Chunks}
89
+
90
+
Ancillary chunks provide optional metadata. Decoders may ignore
91
+
unrecognized ancillary chunks.
92
+
93
+
See {{:https://www.w3.org/TR/png/#11Ancillary-chunks} Section 11.3}. *)
94
+
95
+
(** Transparency chunk - defines transparency information.
96
+
97
+
- Grayscale: 2 bytes (transparent gray value)
98
+
- RGB: 6 bytes (transparent RGB value)
99
+
- Indexed: alpha values for palette entries
100
+
101
+
{{:https://www.w3.org/TR/png/#11tRNS} Section 11.3.2} *)
102
+
val trns : chunk_type
103
+
104
+
(** Primary chromaticities chunk.
105
+
106
+
Specifies 1931 CIE x,y chromaticities of R, G, B primaries
107
+
and white point.
108
+
109
+
{{:https://www.w3.org/TR/png/#11cHRM} Section 11.3.3} *)
110
+
val chrm : chunk_type
111
+
112
+
(** Gamma chunk - image gamma value.
113
+
114
+
Stored as gamma * 100000.
115
+
116
+
{{:https://www.w3.org/TR/png/#11gAMA} Section 11.3.4} *)
117
+
val gama : chunk_type
118
+
119
+
(** ICC profile chunk - embedded ICC color profile.
120
+
121
+
Contains profile name, compression method, and compressed profile.
122
+
123
+
{{:https://www.w3.org/TR/png/#11iCCP} Section 11.3.5} *)
124
+
val iccp : chunk_type
125
+
126
+
(** Significant bits chunk.
127
+
128
+
Indicates original number of significant bits per sample.
129
+
130
+
{{:https://www.w3.org/TR/png/#11sBIT} Section 11.3.6} *)
131
+
val sbit : chunk_type
132
+
133
+
(** Standard RGB chunk - indicates sRGB color space.
134
+
135
+
Contains rendering intent (0-3).
136
+
137
+
{{:https://www.w3.org/TR/png/#11sRGB} Section 11.3.7} *)
138
+
val srgb : chunk_type
139
+
140
+
(** Background color chunk.
141
+
142
+
Default background for image compositing.
143
+
144
+
{{:https://www.w3.org/TR/png/#11bKGD} Section 11.3.8} *)
145
+
val bkgd : chunk_type
146
+
147
+
(** Image histogram chunk.
148
+
149
+
Approximate frequency of palette colors.
150
+
151
+
{{:https://www.w3.org/TR/png/#11hIST} Section 11.3.9} *)
152
+
val hist : chunk_type
153
+
154
+
(** Physical pixel dimensions chunk.
155
+
156
+
Pixel aspect ratio and optional absolute dimensions.
157
+
158
+
{{:https://www.w3.org/TR/png/#11pHYs} Section 11.3.10} *)
159
+
val phys : chunk_type
160
+
161
+
(** Last modification time chunk.
162
+
163
+
{{:https://www.w3.org/TR/png/#11tIME} Section 11.3.11} *)
164
+
val time : chunk_type
165
+
166
+
(** Latin-1 text chunk.
167
+
168
+
Uncompressed textual metadata.
169
+
170
+
{{:https://www.w3.org/TR/png/#11tEXt} Section 11.3.12} *)
171
+
val text : chunk_type
172
+
173
+
(** Compressed text chunk.
174
+
175
+
Zlib-compressed textual metadata.
176
+
177
+
{{:https://www.w3.org/TR/png/#11zTXt} Section 11.3.13} *)
178
+
val ztxt : chunk_type
179
+
180
+
(** International text chunk.
181
+
182
+
UTF-8 textual metadata with language tag.
183
+
184
+
{{:https://www.w3.org/TR/png/#11iTXt} Section 11.3.14} *)
185
+
val itxt : chunk_type
186
+
187
+
(** EXIF metadata chunk.
188
+
189
+
Contains EXIF data as per EXIF specification.
190
+
191
+
{{:https://www.w3.org/TR/png/#11eXIf} Section 11.3.15} *)
192
+
val exif : chunk_type
193
+
194
+
(** {1 APNG Extension Chunks}
195
+
196
+
Animation extension chunks as defined in the APNG specification.
197
+
198
+
{{:https://wiki.mozilla.org/APNG_Specification} APNG Specification} *)
199
+
200
+
(** Animation control chunk - defines animation parameters. *)
201
+
val actl : chunk_type
202
+
203
+
(** Frame control chunk - defines frame parameters. *)
204
+
val fctl : chunk_type
205
+
206
+
(** Frame data chunk - contains compressed frame data. *)
207
+
val fdat : chunk_type
208
+
209
+
(** {1 Chunk Properties}
210
+
211
+
Functions to check chunk properties based on naming conventions.
212
+
See {{:https://www.w3.org/TR/png/#5Chunk-naming-conventions} Section 5.4}. *)
213
+
214
+
(** Check if chunk type is critical.
215
+
216
+
Critical chunks have an uppercase first letter (bit 5 = 0).
217
+
Critical chunks must be understood by the decoder. *)
218
+
val is_critical : chunk_type -> bool
219
+
220
+
(** Check if chunk type is public.
221
+
222
+
Public chunks have an uppercase second letter (bit 5 = 0).
223
+
Public chunks are defined by the PNG specification. *)
224
+
val is_public : chunk_type -> bool
225
+
226
+
(** Check if reserved bit is set.
227
+
228
+
The reserved bit (bit 5 of third letter) must be 0 in current PNG.
229
+
Returns [true] if the bit is set (lowercase = invalid). *)
230
+
val reserved_set : chunk_type -> bool
231
+
232
+
(** Check if chunk is safe to copy.
233
+
234
+
Safe-to-copy chunks have a lowercase fourth letter (bit 5 = 1).
235
+
These can be copied to modified images even if the chunk is unknown. *)
236
+
val safe_to_copy : chunk_type -> bool
237
+
238
+
(** {1 Conversion} *)
239
+
240
+
(** Convert chunk type to 4-character ASCII string.
241
+
242
+
@param ct Chunk type as 32-bit integer
243
+
@return 4-character string (e.g., "IHDR") *)
244
+
val to_string : chunk_type -> string
245
+
246
+
(** Convert 4-character string to chunk type.
247
+
248
+
@param s 4-character ASCII string
249
+
@return Chunk type as 32-bit integer
250
+
@raise Invalid_argument if string length is not 4 *)
251
+
val of_string : string -> chunk_type
252
+
253
+
(** {1 I/O} *)
254
+
255
+
(** Read chunk type from bytes at given position.
256
+
257
+
Reads 4 bytes as big-endian 32-bit integer.
258
+
259
+
@param bytes Source buffer
260
+
@param pos Starting position
261
+
@return Chunk type *)
262
+
val read_type : bytes -> pos:int -> chunk_type
263
+
264
+
(** Write chunk type to bytes at given position.
265
+
266
+
Writes 4 bytes as big-endian 32-bit integer.
267
+
268
+
@param bytes Destination buffer
269
+
@param pos Starting position
270
+
@param ct Chunk type to write *)
271
+
val write_type : bytes -> pos:int -> chunk_type -> unit
+62
vendor/opam/ocaml-png/src/crc32.ml
+62
vendor/opam/ocaml-png/src/crc32.ml
···
1
+
(** CRC32 implementation for PNG (ISO 3309 polynomial).
2
+
3
+
PNG uses the ISO 3309 CRC-32 polynomial:
4
+
x^32 + x^26 + x^23 + x^22 + x^16 + x^12 + x^11 + x^10 + x^8 + x^7 + x^5 + x^4 + x^2 + x + 1
5
+
6
+
This is the same polynomial used in zlib/gzip/PKZIP. *)
7
+
8
+
(** CRC32 lookup table for fast computation.
9
+
Generated using the ISO 3309 polynomial 0xEDB88320 (bit-reversed). *)
10
+
let table =
11
+
let t = Array.make 256 0l in
12
+
for n = 0 to 255 do
13
+
let c = ref (Int32.of_int n) in
14
+
for _ = 0 to 7 do
15
+
if Int32.(logand !c 1l <> 0l) then
16
+
c := Int32.(logxor (shift_right_logical !c 1) 0xEDB88320l)
17
+
else
18
+
c := Int32.shift_right_logical !c 1
19
+
done;
20
+
t.(n) <- !c
21
+
done;
22
+
t
23
+
24
+
(** Initial CRC value (all 1s). *)
25
+
let init = 0xFFFFFFFFl
26
+
27
+
(** Update CRC with a single byte. *)
28
+
let[@inline] update_byte crc byte =
29
+
let index = Int32.(to_int (logand (logxor crc (of_int byte)) 0xFFl)) in
30
+
Int32.(logxor (shift_right_logical crc 8) table.(index))
31
+
32
+
(** Update CRC with bytes from a buffer. *)
33
+
let update crc bytes ~pos ~len =
34
+
let crc = ref crc in
35
+
for i = pos to pos + len - 1 do
36
+
crc := update_byte !crc (Bytes.get_uint8 bytes i)
37
+
done;
38
+
!crc
39
+
40
+
(** Update CRC with a string. *)
41
+
let update_string crc str =
42
+
let crc = ref crc in
43
+
for i = 0 to String.length str - 1 do
44
+
crc := update_byte !crc (Char.code str.[i])
45
+
done;
46
+
!crc
47
+
48
+
(** Finalize CRC (XOR with all 1s). *)
49
+
let[@inline] finalize crc =
50
+
Int32.logxor crc 0xFFFFFFFFl
51
+
52
+
(** Compute CRC32 of bytes in one call. *)
53
+
let compute bytes ~pos ~len =
54
+
finalize (update init bytes ~pos ~len)
55
+
56
+
(** Compute CRC32 of entire bytes. *)
57
+
let compute_bytes bytes =
58
+
compute bytes ~pos:0 ~len:(Bytes.length bytes)
59
+
60
+
(** Compute CRC32 of a string. *)
61
+
let compute_string str =
62
+
finalize (update_string init str)
+123
vendor/opam/ocaml-png/src/crc32.mli
+123
vendor/opam/ocaml-png/src/crc32.mli
···
1
+
(** {1 CRC-32 Checksum for PNG}
2
+
3
+
Implementation of the CRC-32 checksum algorithm as specified in
4
+
{{:https://www.w3.org/TR/png/#5CRC-algorithm} PNG Specification Section 5.5}.
5
+
6
+
{2 Overview}
7
+
8
+
PNG uses CRC-32 checksums to verify chunk integrity. Each chunk
9
+
(except the length field) is protected by a 4-byte CRC following
10
+
the chunk data. The CRC covers the chunk type and chunk data fields.
11
+
12
+
{2 Algorithm}
13
+
14
+
PNG uses the ISO 3309 CRC-32 polynomial, which is the same polynomial
15
+
used in zlib, gzip, PKZIP, and Ethernet:
16
+
17
+
{v
18
+
x^32 + x^26 + x^23 + x^22 + x^16 + x^12 + x^11 + x^10 + x^8 + x^7 + x^5 + x^4 + x^2 + x + 1
19
+
v}
20
+
21
+
In reversed (reflected) form: [0xEDB88320]
22
+
23
+
The algorithm:
24
+
1. Initialize CRC to [0xFFFFFFFF]
25
+
2. For each byte, XOR into low byte of CRC and lookup in table
26
+
3. Finalize by XORing with [0xFFFFFFFF]
27
+
28
+
{2 Sample Code}
29
+
30
+
From {{:https://www.w3.org/TR/png/#D-CRCAppendix} Appendix D}:
31
+
32
+
{[
33
+
(* Full computation example *)
34
+
let data = Bytes.of_string "IEND" in
35
+
let crc = Crc32.compute_bytes data in
36
+
(* crc = 0xAE426082 *)
37
+
]}
38
+
39
+
{2 References}
40
+
41
+
- {{:https://www.w3.org/TR/png/#5CRC-algorithm} PNG Spec Section 5.5}
42
+
- {{:https://www.w3.org/TR/png/#D-CRCAppendix} Appendix D: CRC Algorithm}
43
+
- ISO 3309 / ITU-T V.42
44
+
- RFC 1952 (gzip CRC) *)
45
+
46
+
(** {1 Incremental Interface}
47
+
48
+
For computing CRC over data in chunks. *)
49
+
50
+
(** Initial CRC value ([0xFFFFFFFF]).
51
+
52
+
Start with this value when computing a new CRC. *)
53
+
val init : int32
54
+
55
+
(** Update CRC with bytes from a buffer.
56
+
57
+
@param crc Current CRC state
58
+
@param bytes Source buffer
59
+
@param pos Starting position in buffer
60
+
@param len Number of bytes to process
61
+
@return Updated CRC state (not finalized) *)
62
+
val update : int32 -> bytes -> pos:int -> len:int -> int32
63
+
64
+
(** Update CRC with bytes from a string.
65
+
66
+
@param crc Current CRC state
67
+
@param str Source string
68
+
@return Updated CRC state (not finalized) *)
69
+
val update_string : int32 -> string -> int32
70
+
71
+
(** Update CRC with a single byte.
72
+
73
+
@param crc Current CRC state
74
+
@param byte Byte value (0-255)
75
+
@return Updated CRC state *)
76
+
val update_byte : int32 -> int -> int32
77
+
78
+
(** Finalize CRC computation.
79
+
80
+
XORs with [0xFFFFFFFF] as per PNG specification.
81
+
82
+
@param crc CRC state from [update] calls
83
+
@return Final CRC-32 value *)
84
+
val finalize : int32 -> int32
85
+
86
+
(** {1 One-Shot Interface}
87
+
88
+
Convenience functions for computing CRC in a single call. *)
89
+
90
+
(** Compute CRC-32 of bytes in a buffer.
91
+
92
+
Equivalent to: [finalize (update init bytes ~pos ~len)]
93
+
94
+
@param bytes Source buffer
95
+
@param pos Starting position
96
+
@param len Number of bytes
97
+
@return CRC-32 checksum *)
98
+
val compute : bytes -> pos:int -> len:int -> int32
99
+
100
+
(** Compute CRC-32 of entire bytes buffer.
101
+
102
+
@param bytes Source buffer
103
+
@return CRC-32 checksum *)
104
+
val compute_bytes : bytes -> int32
105
+
106
+
(** Compute CRC-32 of a string.
107
+
108
+
@param str Source string
109
+
@return CRC-32 checksum *)
110
+
val compute_string : string -> int32
111
+
112
+
(** {1 Implementation Notes}
113
+
114
+
This implementation uses a 256-entry lookup table for efficient
115
+
byte-at-a-time computation. The table is computed at module
116
+
initialization using the ISO 3309 polynomial.
117
+
118
+
The algorithm processes one byte at a time:
119
+
{v
120
+
crc = table[(crc XOR byte) AND 0xFF] XOR (crc >> 8)
121
+
v}
122
+
123
+
For verification, the CRC of "123456789" should be [0xCBF43926]. *)
+5
vendor/opam/ocaml-png/src/dune
+5
vendor/opam/ocaml-png/src/dune
+176
vendor/opam/ocaml-png/src/filter.ml
+176
vendor/opam/ocaml-png/src/filter.ml
···
1
+
(** PNG row filtering algorithms.
2
+
3
+
PNG uses row filters to improve compression. Each row is prefixed with
4
+
a filter type byte, followed by the filtered data.
5
+
6
+
Filter types:
7
+
- 0: None - No filtering
8
+
- 1: Sub - Difference from left pixel
9
+
- 2: Up - Difference from above pixel
10
+
- 3: Average - Average of left and above
11
+
- 4: Paeth - Paeth predictor
12
+
13
+
Filtering operates on bytes, not pixels. For multi-byte pixels,
14
+
the "left" pixel is bpp bytes back. *)
15
+
16
+
(** Filter type. *)
17
+
type t =
18
+
| None
19
+
| Sub
20
+
| Up
21
+
| Average
22
+
| Paeth
23
+
24
+
(** Filter type from byte value. *)
25
+
let of_byte = function
26
+
| 0 -> Some None
27
+
| 1 -> Some Sub
28
+
| 2 -> Some Up
29
+
| 3 -> Some Average
30
+
| 4 -> Some Paeth
31
+
| _ -> None
32
+
33
+
(** Filter type to byte value. *)
34
+
let to_byte = function
35
+
| None -> 0
36
+
| Sub -> 1
37
+
| Up -> 2
38
+
| Average -> 3
39
+
| Paeth -> 4
40
+
41
+
(** Paeth predictor function.
42
+
Returns the value closest to p = a + b - c, where:
43
+
- a = left pixel
44
+
- b = above pixel
45
+
- c = upper-left pixel *)
46
+
let[@inline] paeth_predictor a b c =
47
+
let p = a + b - c in
48
+
let pa = abs (p - a) in
49
+
let pb = abs (p - b) in
50
+
let pc = abs (p - c) in
51
+
if pa <= pb && pa <= pc then a
52
+
else if pb <= pc then b
53
+
else c
54
+
55
+
(** Unfilter a row in place.
56
+
[prev] is the previous (already unfiltered) row, or empty for the first row.
57
+
[curr] is the current row data (without filter byte), modified in place.
58
+
[bpp] is bytes per pixel (for filter calculations). *)
59
+
let unfilter_row filter ~prev ~curr ~bpp =
60
+
let len = Bytes.length curr in
61
+
match filter with
62
+
| None -> ()
63
+
64
+
| Sub ->
65
+
(* curr[i] += curr[i - bpp] *)
66
+
for i = bpp to len - 1 do
67
+
let left = Bytes.get_uint8 curr (i - bpp) in
68
+
let x = Bytes.get_uint8 curr i in
69
+
Bytes.set_uint8 curr i ((x + left) land 0xFF)
70
+
done
71
+
72
+
| Up ->
73
+
(* curr[i] += prev[i] *)
74
+
if Bytes.length prev > 0 then
75
+
for i = 0 to len - 1 do
76
+
let above = Bytes.get_uint8 prev i in
77
+
let x = Bytes.get_uint8 curr i in
78
+
Bytes.set_uint8 curr i ((x + above) land 0xFF)
79
+
done
80
+
81
+
| Average ->
82
+
(* curr[i] += floor((left + above) / 2) *)
83
+
for i = 0 to len - 1 do
84
+
let left = if i >= bpp then Bytes.get_uint8 curr (i - bpp) else 0 in
85
+
let above = if Bytes.length prev > 0 then Bytes.get_uint8 prev i else 0 in
86
+
let x = Bytes.get_uint8 curr i in
87
+
Bytes.set_uint8 curr i ((x + (left + above) / 2) land 0xFF)
88
+
done
89
+
90
+
| Paeth ->
91
+
(* curr[i] += paeth(left, above, upper_left) *)
92
+
for i = 0 to len - 1 do
93
+
let left = if i >= bpp then Bytes.get_uint8 curr (i - bpp) else 0 in
94
+
let above = if Bytes.length prev > 0 then Bytes.get_uint8 prev i else 0 in
95
+
let upper_left =
96
+
if i >= bpp && Bytes.length prev > 0 then Bytes.get_uint8 prev (i - bpp)
97
+
else 0
98
+
in
99
+
let x = Bytes.get_uint8 curr i in
100
+
Bytes.set_uint8 curr i ((x + paeth_predictor left above upper_left) land 0xFF)
101
+
done
102
+
103
+
(** Filter a row for encoding.
104
+
[prev] is the previous (unfiltered) row, or empty for the first row.
105
+
[curr] is the current unfiltered row.
106
+
[output] receives the filtered data.
107
+
[bpp] is bytes per pixel. *)
108
+
let filter_row filter ~prev ~curr ~output ~bpp =
109
+
let len = Bytes.length curr in
110
+
match filter with
111
+
| None ->
112
+
Bytes.blit curr 0 output 0 len
113
+
114
+
| Sub ->
115
+
for i = 0 to len - 1 do
116
+
let left = if i >= bpp then Bytes.get_uint8 curr (i - bpp) else 0 in
117
+
let x = Bytes.get_uint8 curr i in
118
+
Bytes.set_uint8 output i ((x - left) land 0xFF)
119
+
done
120
+
121
+
| Up ->
122
+
for i = 0 to len - 1 do
123
+
let above = if Bytes.length prev > 0 then Bytes.get_uint8 prev i else 0 in
124
+
let x = Bytes.get_uint8 curr i in
125
+
Bytes.set_uint8 output i ((x - above) land 0xFF)
126
+
done
127
+
128
+
| Average ->
129
+
for i = 0 to len - 1 do
130
+
let left = if i >= bpp then Bytes.get_uint8 curr (i - bpp) else 0 in
131
+
let above = if Bytes.length prev > 0 then Bytes.get_uint8 prev i else 0 in
132
+
let x = Bytes.get_uint8 curr i in
133
+
Bytes.set_uint8 output i ((x - (left + above) / 2) land 0xFF)
134
+
done
135
+
136
+
| Paeth ->
137
+
for i = 0 to len - 1 do
138
+
let left = if i >= bpp then Bytes.get_uint8 curr (i - bpp) else 0 in
139
+
let above = if Bytes.length prev > 0 then Bytes.get_uint8 prev i else 0 in
140
+
let upper_left =
141
+
if i >= bpp && Bytes.length prev > 0 then Bytes.get_uint8 prev (i - bpp)
142
+
else 0
143
+
in
144
+
let x = Bytes.get_uint8 curr i in
145
+
Bytes.set_uint8 output i ((x - paeth_predictor left above upper_left) land 0xFF)
146
+
done
147
+
148
+
(** Compute sum of absolute differences for filter selection heuristic.
149
+
Lower is better (more compressible). *)
150
+
let sum_abs_diff bytes =
151
+
let sum = ref 0 in
152
+
for i = 0 to Bytes.length bytes - 1 do
153
+
let b = Bytes.get_uint8 bytes i in
154
+
(* Interpret as signed for better heuristic *)
155
+
let signed = if b > 127 then b - 256 else b in
156
+
sum := !sum + abs signed
157
+
done;
158
+
!sum
159
+
160
+
(** All filter types for adaptive selection. *)
161
+
let all_filters = [None; Sub; Up; Average; Paeth]
162
+
163
+
(** Select the best filter for a row using minimum sum heuristic.
164
+
Returns the filter type and filtered data. *)
165
+
let select_best_filter ~prev ~curr ~bpp =
166
+
let len = Bytes.length curr in
167
+
let output = Bytes.create len in
168
+
let best_filter, _best_sum =
169
+
List.fold_left (fun (best_f, best_s) f ->
170
+
filter_row f ~prev ~curr ~output ~bpp;
171
+
let sum = sum_abs_diff output in
172
+
if sum < best_s then (f, sum) else (best_f, best_s)
173
+
) (None, max_int) all_filters
174
+
in
175
+
filter_row best_filter ~prev ~curr ~output ~bpp;
176
+
(best_filter, output)
+150
vendor/opam/ocaml-png/src/filter.mli
+150
vendor/opam/ocaml-png/src/filter.mli
···
1
+
(** {1 PNG Row Filtering}
2
+
3
+
Implementation of PNG row filtering algorithms as defined in
4
+
{{:https://www.w3.org/TR/png/#9Filters} PNG Specification Section 9}.
5
+
6
+
{2 Overview}
7
+
8
+
PNG uses row filters to preprocess image data before compression.
9
+
Each scanline is prefixed with a filter type byte (0-4) followed by
10
+
the filtered row data. Filtering improves compression by exploiting
11
+
correlation between adjacent pixels.
12
+
13
+
{2 Filter Types}
14
+
15
+
As defined in {{:https://www.w3.org/TR/png/#9Filter-types} Section 9.2}:
16
+
17
+
- {b None (0)}: No filtering, [Filt(x) = Orig(x)]
18
+
- {b Sub (1)}: Difference from left pixel, [Filt(x) = Orig(x) - Orig(a)]
19
+
- {b Up (2)}: Difference from above pixel, [Filt(x) = Orig(x) - Orig(b)]
20
+
- {b Average (3)}: Average of left and above, [Filt(x) = Orig(x) - floor((Orig(a) + Orig(b)) / 2)]
21
+
- {b Paeth (4)}: Paeth predictor, [Filt(x) = Orig(x) - PaethPredictor(a, b, c)]
22
+
23
+
Where:
24
+
- [x] = byte being filtered
25
+
- [a] = byte to the left (or 0 if at left edge)
26
+
- [b] = byte above (or 0 if first row)
27
+
- [c] = byte above and to left (or 0 if at edge)
28
+
29
+
{2 Byte-Level Operation}
30
+
31
+
Filtering operates on {i bytes}, not pixels. For multi-byte pixels,
32
+
[a] refers to the corresponding byte in the pixel [bpp] bytes to the left.
33
+
For sub-byte pixels (bit depth < 8), [bpp = 1] is used.
34
+
35
+
{2 References}
36
+
37
+
- {{:https://www.w3.org/TR/png/#9Filters} PNG Spec Section 9: Filtering}
38
+
- {{:https://www.w3.org/TR/png/#9Filter-types} Section 9.2: Filter Types}
39
+
- {{:https://www.w3.org/TR/png/#9Filter-type-4-Paeth} Section 9.4: Paeth Predictor} *)
40
+
41
+
(** {1 Types} *)
42
+
43
+
(** Filter type as defined in {{:https://www.w3.org/TR/png/#9Filter-types}
44
+
PNG Spec Section 9.2}.
45
+
46
+
Each filter type represents a different prediction strategy for
47
+
improving compression. *)
48
+
type t =
49
+
| None (** Type 0: No filtering *)
50
+
| Sub (** Type 1: Byte difference from left *)
51
+
| Up (** Type 2: Byte difference from above *)
52
+
| Average (** Type 3: Average of left and above *)
53
+
| Paeth (** Type 4: Paeth predictor *)
54
+
55
+
(** {1 Conversion} *)
56
+
57
+
(** Convert a filter type byte to the filter type.
58
+
59
+
@param byte Filter type byte (0-4)
60
+
@return [Some filter] if valid, [None] otherwise *)
61
+
val of_byte : int -> t option
62
+
63
+
(** Convert a filter type to its byte representation.
64
+
65
+
@param filter Filter type
66
+
@return Integer 0-4 *)
67
+
val to_byte : t -> int
68
+
69
+
(** {1 Decoding (Unfiltering)}
70
+
71
+
Unfiltering reverses the filter transformation to recover the
72
+
original pixel data. This is applied during PNG decoding. *)
73
+
74
+
(** Unfilter a row in place.
75
+
76
+
Reverses the filter transformation on [curr] using the previous row
77
+
[prev] as reference. The [curr] buffer is modified in place.
78
+
79
+
As defined in {{:https://www.w3.org/TR/png/#9Filter-types} Section 9.2},
80
+
the reconstruction functions are:
81
+
- None: [Recon(x) = Filt(x)]
82
+
- Sub: [Recon(x) = Filt(x) + Recon(a)]
83
+
- Up: [Recon(x) = Filt(x) + Recon(b)]
84
+
- Average: [Recon(x) = Filt(x) + floor((Recon(a) + Recon(b)) / 2)]
85
+
- Paeth: [Recon(x) = Filt(x) + PaethPredictor(Recon(a), Recon(b), Recon(c))]
86
+
87
+
@param filter The filter type used on this row
88
+
@param prev Previous (already unfiltered) row, or empty for first row
89
+
@param curr Current row data (modified in place)
90
+
@param bpp Bytes per pixel (for multi-byte pixel alignment) *)
91
+
val unfilter_row : t -> prev:bytes -> curr:bytes -> bpp:int -> unit
92
+
93
+
(** {1 Encoding (Filtering)}
94
+
95
+
Filtering transforms pixel data to improve compression.
96
+
This is applied during PNG encoding. *)
97
+
98
+
(** Filter a row for encoding.
99
+
100
+
Applies the filter transformation to [curr] and writes the result
101
+
to [output].
102
+
103
+
@param filter Filter type to apply
104
+
@param prev Previous (unfiltered) row, or empty for first row
105
+
@param curr Current unfiltered row
106
+
@param output Buffer to receive filtered data (same length as [curr])
107
+
@param bpp Bytes per pixel *)
108
+
val filter_row : t -> prev:bytes -> curr:bytes -> output:bytes -> bpp:int -> unit
109
+
110
+
(** {1 Adaptive Filter Selection}
111
+
112
+
PNG encoders typically select the best filter for each row to
113
+
maximize compression. The standard heuristic is to minimize the
114
+
sum of absolute differences of the filtered output.
115
+
116
+
See {{:https://www.w3.org/TR/png/#12Filter-selection} Section 12.8}
117
+
for filter selection recommendations. *)
118
+
119
+
(** All filter types, for iterating during adaptive selection. *)
120
+
val all_filters : t list
121
+
122
+
(** Select the best filter for a row using the minimum sum heuristic.
123
+
124
+
Tries all five filter types and selects the one that produces
125
+
the lowest sum of absolute differences (interpreted as signed bytes).
126
+
This heuristic approximates minimum entropy and typically produces
127
+
good compression.
128
+
129
+
@param prev Previous (unfiltered) row, or empty for first row
130
+
@param curr Current unfiltered row
131
+
@param bpp Bytes per pixel
132
+
@return Tuple of (best filter type, filtered data) *)
133
+
val select_best_filter : prev:bytes -> curr:bytes -> bpp:int -> t * bytes
134
+
135
+
(** {1 Paeth Predictor}
136
+
137
+
The Paeth predictor is defined in {{:https://www.w3.org/TR/png/#9Filter-type-4-Paeth}
138
+
PNG Spec Section 9.4}. It selects the value (a, b, or c) closest to
139
+
the linear prediction [p = a + b - c]. *)
140
+
141
+
(** Paeth predictor function.
142
+
143
+
Computes the Paeth prediction given three neighboring bytes.
144
+
Returns the value closest to [p = a + b - c].
145
+
146
+
@param a Byte to the left (or 0)
147
+
@param b Byte above (or 0)
148
+
@param c Byte above-left (or 0)
149
+
@return Predicted byte value *)
150
+
val paeth_predictor : int -> int -> int -> int
+648
vendor/opam/ocaml-png/src/png.ml
+648
vendor/opam/ocaml-png/src/png.ml
···
1
+
(** OCaml PNG Library
2
+
3
+
A pure OCaml implementation of PNG encoding and decoding.
4
+
Based on the W3C PNG Specification (Third Edition). *)
5
+
6
+
(** {1 Types} *)
7
+
8
+
(** Color type as per PNG spec section 11.2.2 *)
9
+
type color_type =
10
+
| Grayscale (** 0 - 1 sample per pixel *)
11
+
| RGB (** 2 - 3 samples per pixel *)
12
+
| Indexed (** 3 - 1 sample (palette index) *)
13
+
| Grayscale_alpha (** 4 - 2 samples per pixel *)
14
+
| RGBA (** 6 - 4 samples per pixel *)
15
+
16
+
(** Bit depth: 1, 2, 4, 8, or 16 bits per sample *)
17
+
type bit_depth =
18
+
| One
19
+
| Two
20
+
| Four
21
+
| Eight
22
+
| Sixteen
23
+
24
+
(** Interlace method *)
25
+
type interlace =
26
+
| No_interlace (** 0 - Sequential *)
27
+
| Adam7 (** 1 - Adam7 interlacing *)
28
+
29
+
(** Image header information *)
30
+
type info = {
31
+
width : int;
32
+
height : int;
33
+
bit_depth : bit_depth;
34
+
color_type : color_type;
35
+
interlace : interlace;
36
+
palette : bytes option;
37
+
trns : bytes option;
38
+
gamma : float option;
39
+
srgb : int option;
40
+
chrm : (int * int * int * int * int * int * int * int) option;
41
+
bkgd : bytes option;
42
+
phys : (int * int * int) option;
43
+
}
44
+
45
+
(** Decoded image *)
46
+
type image = {
47
+
info : info;
48
+
data : bytes; (** Row-major pixel data *)
49
+
}
50
+
51
+
(** {1 Errors} *)
52
+
53
+
type error =
54
+
| Invalid_signature
55
+
| Invalid_ihdr
56
+
| Invalid_chunk_crc
57
+
| Invalid_chunk_length
58
+
| Invalid_filter of int
59
+
| Invalid_color_type of int
60
+
| Invalid_bit_depth of int
61
+
| Invalid_interlace of int
62
+
| Unsupported of string
63
+
| Truncated
64
+
| Decompression_error of string
65
+
66
+
exception Png_error of error
67
+
68
+
let string_of_error = function
69
+
| Invalid_signature -> "Invalid PNG signature"
70
+
| Invalid_ihdr -> "Invalid IHDR chunk"
71
+
| Invalid_chunk_crc -> "Invalid chunk CRC"
72
+
| Invalid_chunk_length -> "Invalid chunk length"
73
+
| Invalid_filter n -> Printf.sprintf "Invalid filter type: %d" n
74
+
| Invalid_color_type n -> Printf.sprintf "Invalid color type: %d" n
75
+
| Invalid_bit_depth n -> Printf.sprintf "Invalid bit depth: %d" n
76
+
| Invalid_interlace n -> Printf.sprintf "Invalid interlace method: %d" n
77
+
| Unsupported s -> Printf.sprintf "Unsupported: %s" s
78
+
| Truncated -> "Truncated PNG data"
79
+
| Decompression_error s -> Printf.sprintf "Decompression error: %s" s
80
+
81
+
let pp_error fmt e = Format.pp_print_string fmt (string_of_error e)
82
+
83
+
(** {1 Internal Helpers} *)
84
+
85
+
(** Extract value from option or raise Png_error. *)
86
+
let require_some ~error = function
87
+
| Some x -> x
88
+
| None -> raise (Png_error error)
89
+
90
+
(** PNG signature: 137 80 78 71 13 10 26 10 *)
91
+
let signature = "\137PNG\r\n\026\n"
92
+
93
+
let color_type_of_int = function
94
+
| 0 -> Some Grayscale
95
+
| 2 -> Some RGB
96
+
| 3 -> Some Indexed
97
+
| 4 -> Some Grayscale_alpha
98
+
| 6 -> Some RGBA
99
+
| _ -> None
100
+
101
+
let int_of_color_type = function
102
+
| Grayscale -> 0
103
+
| RGB -> 2
104
+
| Indexed -> 3
105
+
| Grayscale_alpha -> 4
106
+
| RGBA -> 6
107
+
108
+
let bit_depth_of_int = function
109
+
| 1 -> Some One
110
+
| 2 -> Some Two
111
+
| 4 -> Some Four
112
+
| 8 -> Some Eight
113
+
| 16 -> Some Sixteen
114
+
| _ -> None
115
+
116
+
let int_of_bit_depth = function
117
+
| One -> 1
118
+
| Two -> 2
119
+
| Four -> 4
120
+
| Eight -> 8
121
+
| Sixteen -> 16
122
+
123
+
let interlace_of_int = function
124
+
| 0 -> Some No_interlace
125
+
| 1 -> Some Adam7
126
+
| _ -> None
127
+
128
+
(** Check if color type and bit depth combination is valid. *)
129
+
let is_valid_combination color_type bit_depth =
130
+
match color_type, bit_depth with
131
+
| Grayscale, (One | Two | Four | Eight | Sixteen) -> true
132
+
| RGB, (Eight | Sixteen) -> true
133
+
| Indexed, (One | Two | Four | Eight) -> true
134
+
| Grayscale_alpha, (Eight | Sixteen) -> true
135
+
| RGBA, (Eight | Sixteen) -> true
136
+
| _ -> false
137
+
138
+
(** Number of samples per pixel for color type. *)
139
+
let samples_per_pixel = function
140
+
| Grayscale -> 1
141
+
| RGB -> 3
142
+
| Indexed -> 1
143
+
| Grayscale_alpha -> 2
144
+
| RGBA -> 4
145
+
146
+
(** Bytes per pixel (for filtering). Minimum 1 for sub-byte pixels. *)
147
+
let bytes_per_pixel color_type bit_depth =
148
+
let bits = samples_per_pixel color_type * int_of_bit_depth bit_depth in
149
+
max 1 (bits / 8)
150
+
151
+
(** Bytes per row (excluding filter byte). *)
152
+
let bytes_per_row width color_type bit_depth =
153
+
let bits_per_row = width * samples_per_pixel color_type * int_of_bit_depth bit_depth in
154
+
(bits_per_row + 7) / 8
155
+
156
+
(** Read 32-bit big-endian integer from bytes. *)
157
+
let get_int32_be bytes pos =
158
+
let b0 = Bytes.get_uint8 bytes pos in
159
+
let b1 = Bytes.get_uint8 bytes (pos + 1) in
160
+
let b2 = Bytes.get_uint8 bytes (pos + 2) in
161
+
let b3 = Bytes.get_uint8 bytes (pos + 3) in
162
+
Int32.(logor (logor (logor
163
+
(shift_left (of_int b0) 24)
164
+
(shift_left (of_int b1) 16))
165
+
(shift_left (of_int b2) 8))
166
+
(of_int b3))
167
+
168
+
(** Write 32-bit big-endian integer to bytes. *)
169
+
let set_int32_be bytes pos value =
170
+
Bytes.set_uint8 bytes pos Int32.(to_int (logand (shift_right_logical value 24) 0xFFl));
171
+
Bytes.set_uint8 bytes (pos + 1) Int32.(to_int (logand (shift_right_logical value 16) 0xFFl));
172
+
Bytes.set_uint8 bytes (pos + 2) Int32.(to_int (logand (shift_right_logical value 8) 0xFFl));
173
+
Bytes.set_uint8 bytes (pos + 3) Int32.(to_int (logand value 0xFFl))
174
+
175
+
(** {1 Decoder} *)
176
+
177
+
(** Read and validate PNG signature. *)
178
+
let read_signature bytes pos =
179
+
if pos + 8 > Bytes.length bytes then raise (Png_error Truncated);
180
+
for i = 0 to 7 do
181
+
if Bytes.get bytes (pos + i) <> signature.[i] then
182
+
raise (Png_error Invalid_signature)
183
+
done;
184
+
pos + 8
185
+
186
+
(** Read a chunk: returns (chunk_type, data, next_pos). *)
187
+
let read_chunk bytes pos =
188
+
if pos + 4 > Bytes.length bytes then raise (Png_error Truncated);
189
+
let length = Int32.to_int (get_int32_be bytes pos) in
190
+
if length < 0 || pos + 12 + length > Bytes.length bytes then
191
+
raise (Png_error Invalid_chunk_length);
192
+
let chunk_type = Chunk.read_type bytes ~pos:(pos + 4) in
193
+
let data_start = pos + 8 in
194
+
let data = Bytes.sub bytes data_start length in
195
+
let crc_pos = data_start + length in
196
+
let stored_crc = get_int32_be bytes crc_pos in
197
+
(* CRC covers chunk type + data *)
198
+
let computed_crc =
199
+
let crc = Crc32.update Crc32.init bytes ~pos:(pos + 4) ~len:(4 + length) in
200
+
Crc32.finalize crc
201
+
in
202
+
if stored_crc <> computed_crc then raise (Png_error Invalid_chunk_crc);
203
+
(chunk_type, data, crc_pos + 4)
204
+
205
+
(** Parse IHDR chunk data. *)
206
+
let parse_ihdr data =
207
+
if Bytes.length data <> 13 then raise (Png_error Invalid_ihdr);
208
+
let width = Int32.to_int (get_int32_be data 0) in
209
+
let height = Int32.to_int (get_int32_be data 4) in
210
+
let bit_depth_int = Bytes.get_uint8 data 8 in
211
+
let color_type_int = Bytes.get_uint8 data 9 in
212
+
let compression = Bytes.get_uint8 data 10 in
213
+
let filter_method = Bytes.get_uint8 data 11 in
214
+
let interlace_int = Bytes.get_uint8 data 12 in
215
+
216
+
if compression <> 0 then
217
+
raise (Png_error (Unsupported "unknown compression method"));
218
+
if filter_method <> 0 then
219
+
raise (Png_error (Unsupported "unknown filter method"));
220
+
221
+
let bit_depth =
222
+
bit_depth_of_int bit_depth_int
223
+
|> require_some ~error:(Invalid_bit_depth bit_depth_int)
224
+
in
225
+
let color_type =
226
+
color_type_of_int color_type_int
227
+
|> require_some ~error:(Invalid_color_type color_type_int)
228
+
in
229
+
let interlace =
230
+
interlace_of_int interlace_int
231
+
|> require_some ~error:(Invalid_interlace interlace_int)
232
+
in
233
+
234
+
if not (is_valid_combination color_type bit_depth) then
235
+
raise (Png_error (Unsupported "invalid color type / bit depth combination"));
236
+
237
+
{
238
+
width;
239
+
height;
240
+
bit_depth;
241
+
color_type;
242
+
interlace;
243
+
palette = None;
244
+
trns = None;
245
+
gamma = None;
246
+
srgb = None;
247
+
chrm = None;
248
+
bkgd = None;
249
+
phys = None;
250
+
}
251
+
252
+
(** Decode PNG from bytes. *)
253
+
let decode bytes =
254
+
let len = Bytes.length bytes in
255
+
if len < 8 then raise (Png_error Truncated);
256
+
257
+
(* Read signature *)
258
+
let pos = read_signature bytes 0 in
259
+
260
+
(* Read IHDR (must be first chunk) *)
261
+
let (chunk_type, ihdr_data, pos) = read_chunk bytes pos in
262
+
if chunk_type <> Chunk.ihdr then raise (Png_error Invalid_ihdr);
263
+
let info = ref (parse_ihdr ihdr_data) in
264
+
265
+
(* Collect IDAT chunks and ancillary chunks *)
266
+
let idat_chunks = ref [] in
267
+
let pos = ref pos in
268
+
let done_reading = ref false in
269
+
270
+
while not !done_reading && !pos < len do
271
+
let (chunk_type, data, next_pos) = read_chunk bytes !pos in
272
+
pos := next_pos;
273
+
274
+
if chunk_type = Chunk.idat then
275
+
idat_chunks := data :: !idat_chunks
276
+
else if chunk_type = Chunk.iend then
277
+
done_reading := true
278
+
else if chunk_type = Chunk.plte then
279
+
info := { !info with palette = Some data }
280
+
else if chunk_type = Chunk.trns then
281
+
info := { !info with trns = Some data }
282
+
else if chunk_type = Chunk.gama then begin
283
+
if Bytes.length data >= 4 then
284
+
let gamma_int = Int32.to_int (get_int32_be data 0) in
285
+
info := { !info with gamma = Some (float_of_int gamma_int /. 100000.0) }
286
+
end
287
+
else if chunk_type = Chunk.srgb then begin
288
+
if Bytes.length data >= 1 then
289
+
info := { !info with srgb = Some (Bytes.get_uint8 data 0) }
290
+
end
291
+
else if chunk_type = Chunk.bkgd then
292
+
info := { !info with bkgd = Some data }
293
+
else if chunk_type = Chunk.phys then begin
294
+
if Bytes.length data >= 9 then
295
+
let xppu = Int32.to_int (get_int32_be data 0) in
296
+
let yppu = Int32.to_int (get_int32_be data 4) in
297
+
let unit_type = Bytes.get_uint8 data 8 in
298
+
info := { !info with phys = Some (xppu, yppu, unit_type) }
299
+
end
300
+
(* Ignore other ancillary chunks *)
301
+
done;
302
+
303
+
let info = !info in
304
+
305
+
(* Concatenate IDAT data *)
306
+
let idat_chunks = List.rev !idat_chunks in
307
+
let idat_total_len = List.fold_left (fun acc d -> acc + Bytes.length d) 0 idat_chunks in
308
+
let idat_data = Bytes.create idat_total_len in
309
+
let _ = List.fold_left (fun off d ->
310
+
Bytes.blit d 0 idat_data off (Bytes.length d);
311
+
off + Bytes.length d
312
+
) 0 idat_chunks in
313
+
314
+
(* Decompress IDAT data using decompress library Higher API *)
315
+
let decompressed =
316
+
try
317
+
let str = Bytes.to_string idat_data in
318
+
let i = De.bigstring_create De.io_buffer_size in
319
+
let o = De.bigstring_create De.io_buffer_size in
320
+
let allocate bits = De.make_window ~bits in
321
+
let r = Buffer.create (info.height * (bytes_per_row info.width info.color_type info.bit_depth + 1)) in
322
+
let p = ref 0 in
323
+
let refill buf =
324
+
let len = min (String.length str - !p) De.io_buffer_size in
325
+
Bigstringaf.blit_from_string str ~src_off:!p buf ~dst_off:0 ~len;
326
+
p := !p + len;
327
+
len
328
+
in
329
+
let flush buf len =
330
+
let s = Bigstringaf.substring buf ~off:0 ~len in
331
+
Buffer.add_string r s
332
+
in
333
+
match Zl.Higher.uncompress ~allocate ~refill ~flush i o with
334
+
| Ok () -> Bytes.of_string (Buffer.contents r)
335
+
| Error (`Msg msg) -> raise (Png_error (Decompression_error msg))
336
+
with
337
+
| Png_error _ as e -> raise e
338
+
| e -> raise (Png_error (Decompression_error (Printexc.to_string e)))
339
+
in
340
+
341
+
(* Calculate dimensions *)
342
+
let row_bytes = bytes_per_row info.width info.color_type info.bit_depth in
343
+
let bpp = bytes_per_pixel info.color_type info.bit_depth in
344
+
345
+
(* Handle interlacing *)
346
+
let image_data =
347
+
match info.interlace with
348
+
| No_interlace ->
349
+
(* Non-interlaced: each row is filter_byte + row_data *)
350
+
let expected_len = info.height * (1 + row_bytes) in
351
+
if Bytes.length decompressed < expected_len then
352
+
raise (Png_error Truncated);
353
+
354
+
let output = Bytes.create (info.height * row_bytes) in
355
+
let prev_row = ref Bytes.empty in
356
+
357
+
for y = 0 to info.height - 1 do
358
+
let row_start = y * (1 + row_bytes) in
359
+
let filter_byte = Bytes.get_uint8 decompressed row_start in
360
+
let filter =
361
+
Filter.of_byte filter_byte
362
+
|> require_some ~error:(Invalid_filter filter_byte)
363
+
in
364
+
let curr_row = Bytes.sub decompressed (row_start + 1) row_bytes in
365
+
Filter.unfilter_row filter ~prev:!prev_row ~curr:curr_row ~bpp;
366
+
Bytes.blit curr_row 0 output (y * row_bytes) row_bytes;
367
+
prev_row := curr_row
368
+
done;
369
+
output
370
+
371
+
| Adam7 ->
372
+
(* Adam7 interlacing: 7 passes with sub-images *)
373
+
let output = Bytes.create (info.height * row_bytes) in
374
+
(* Initialize to zero *)
375
+
Bytes.fill output 0 (Bytes.length output) '\000';
376
+
377
+
(* Adam7 pass parameters: (x_offset, y_offset, x_step, y_step) *)
378
+
let passes = [|
379
+
(0, 0, 8, 8); (* Pass 1 *)
380
+
(4, 0, 8, 8); (* Pass 2 *)
381
+
(0, 4, 4, 8); (* Pass 3 *)
382
+
(2, 0, 4, 4); (* Pass 4 *)
383
+
(0, 2, 2, 4); (* Pass 5 *)
384
+
(1, 0, 2, 2); (* Pass 6 *)
385
+
(0, 1, 1, 2); (* Pass 7 *)
386
+
|] in
387
+
388
+
let src_pos = ref 0 in
389
+
390
+
for pass = 0 to 6 do
391
+
let (x_off, y_off, x_step, y_step) = passes.(pass) in
392
+
393
+
(* Calculate sub-image dimensions for this pass *)
394
+
let pass_width = (info.width - x_off + x_step - 1) / x_step in
395
+
let pass_height = (info.height - y_off + y_step - 1) / y_step in
396
+
397
+
if pass_width > 0 && pass_height > 0 then begin
398
+
let pass_row_bytes = bytes_per_row pass_width info.color_type info.bit_depth in
399
+
let pass_bpp = bpp in
400
+
let prev_row = ref Bytes.empty in
401
+
402
+
for py = 0 to pass_height - 1 do
403
+
if !src_pos >= Bytes.length decompressed then
404
+
raise (Png_error Truncated);
405
+
406
+
let filter_byte = Bytes.get_uint8 decompressed !src_pos in
407
+
let filter =
408
+
Filter.of_byte filter_byte
409
+
|> require_some ~error:(Invalid_filter filter_byte)
410
+
in
411
+
incr src_pos;
412
+
413
+
if !src_pos + pass_row_bytes > Bytes.length decompressed then
414
+
raise (Png_error Truncated);
415
+
416
+
let curr_row = Bytes.sub decompressed !src_pos pass_row_bytes in
417
+
src_pos := !src_pos + pass_row_bytes;
418
+
419
+
Filter.unfilter_row filter ~prev:!prev_row ~curr:curr_row ~bpp:pass_bpp;
420
+
421
+
(* Expand this row into the output image *)
422
+
let dest_y = y_off + py * y_step in
423
+
let bits_per_pixel = samples_per_pixel info.color_type * int_of_bit_depth info.bit_depth in
424
+
425
+
if bits_per_pixel >= 8 then begin
426
+
(* Byte-aligned pixels *)
427
+
let pixel_bytes = bits_per_pixel / 8 in
428
+
for px = 0 to pass_width - 1 do
429
+
let dest_x = x_off + px * x_step in
430
+
let src_offset = px * pixel_bytes in
431
+
let dest_offset = dest_y * row_bytes + dest_x * pixel_bytes in
432
+
Bytes.blit curr_row src_offset output dest_offset pixel_bytes
433
+
done
434
+
end else begin
435
+
(* Sub-byte pixels (1, 2, or 4 bits) *)
436
+
let pixels_per_byte = 8 / bits_per_pixel in
437
+
for px = 0 to pass_width - 1 do
438
+
let dest_x = x_off + px * x_step in
439
+
(* Extract pixel from source *)
440
+
let src_byte_idx = px / pixels_per_byte in
441
+
let src_bit_idx = (pixels_per_byte - 1 - (px mod pixels_per_byte)) * bits_per_pixel in
442
+
let src_byte = Bytes.get_uint8 curr_row src_byte_idx in
443
+
let mask = (1 lsl bits_per_pixel) - 1 in
444
+
let pixel = (src_byte lsr src_bit_idx) land mask in
445
+
(* Write pixel to destination *)
446
+
let dest_byte_idx = dest_y * row_bytes + dest_x / pixels_per_byte in
447
+
let dest_bit_idx = (pixels_per_byte - 1 - (dest_x mod pixels_per_byte)) * bits_per_pixel in
448
+
let dest_byte = Bytes.get_uint8 output dest_byte_idx in
449
+
let clear_mask = lnot (mask lsl dest_bit_idx) in
450
+
let new_byte = (dest_byte land clear_mask) lor (pixel lsl dest_bit_idx) in
451
+
Bytes.set_uint8 output dest_byte_idx new_byte
452
+
done
453
+
end;
454
+
455
+
prev_row := curr_row
456
+
done
457
+
end
458
+
done;
459
+
output
460
+
in
461
+
462
+
{ info; data = image_data }
463
+
464
+
(** Decode PNG from file. *)
465
+
let decode_file filename =
466
+
let ic = open_in_bin filename in
467
+
let len = in_channel_length ic in
468
+
let bytes = Bytes.create len in
469
+
really_input ic bytes 0 len;
470
+
close_in ic;
471
+
decode bytes
472
+
473
+
(** {1 Encoder} *)
474
+
475
+
(** Write a chunk to a buffer list. *)
476
+
let write_chunk chunks chunk_type data =
477
+
let length = Bytes.length data in
478
+
let chunk = Bytes.create (12 + length) in
479
+
set_int32_be chunk 0 (Int32.of_int length);
480
+
Chunk.write_type chunk ~pos:4 chunk_type;
481
+
Bytes.blit data 0 chunk 8 length;
482
+
(* Compute CRC over type + data *)
483
+
let crc = Crc32.update Crc32.init chunk ~pos:4 ~len:(4 + length) in
484
+
let crc = Crc32.finalize crc in
485
+
set_int32_be chunk (8 + length) crc;
486
+
chunks := chunk :: !chunks
487
+
488
+
(** Encode image to PNG bytes. *)
489
+
let encode ?(compression=6) ?(filter_strategy=`Adaptive) image =
490
+
let info = image.info in
491
+
let chunks = ref [] in
492
+
493
+
(* Write IHDR *)
494
+
let ihdr = Bytes.create 13 in
495
+
set_int32_be ihdr 0 (Int32.of_int info.width);
496
+
set_int32_be ihdr 4 (Int32.of_int info.height);
497
+
Bytes.set_uint8 ihdr 8 (int_of_bit_depth info.bit_depth);
498
+
Bytes.set_uint8 ihdr 9 (int_of_color_type info.color_type);
499
+
Bytes.set_uint8 ihdr 10 0; (* compression method *)
500
+
Bytes.set_uint8 ihdr 11 0; (* filter method *)
501
+
Bytes.set_uint8 ihdr 12 (match info.interlace with No_interlace -> 0 | Adam7 -> 1);
502
+
write_chunk chunks Chunk.ihdr ihdr;
503
+
504
+
(* Write PLTE if indexed *)
505
+
(match info.palette with
506
+
| Some palette -> write_chunk chunks Chunk.plte palette
507
+
| None -> ());
508
+
509
+
(* Write tRNS if present *)
510
+
(match info.trns with
511
+
| Some trns -> write_chunk chunks Chunk.trns trns
512
+
| None -> ());
513
+
514
+
(* Write gAMA if present *)
515
+
(match info.gamma with
516
+
| Some gamma ->
517
+
let gama = Bytes.create 4 in
518
+
set_int32_be gama 0 (Int32.of_int (int_of_float (gamma *. 100000.0)));
519
+
write_chunk chunks Chunk.gama gama
520
+
| None -> ());
521
+
522
+
(* Write sRGB if present *)
523
+
(match info.srgb with
524
+
| Some intent ->
525
+
let srgb = Bytes.create 1 in
526
+
Bytes.set_uint8 srgb 0 intent;
527
+
write_chunk chunks Chunk.srgb srgb
528
+
| None -> ());
529
+
530
+
(* Prepare filtered image data *)
531
+
let row_bytes = bytes_per_row info.width info.color_type info.bit_depth in
532
+
let bpp = bytes_per_pixel info.color_type info.bit_depth in
533
+
534
+
(* Only support non-interlaced for now *)
535
+
let filtered_data =
536
+
match info.interlace with
537
+
| No_interlace ->
538
+
let output = Bytes.create (info.height * (1 + row_bytes)) in
539
+
let prev_row = ref Bytes.empty in
540
+
let filter_output = Bytes.create row_bytes in
541
+
542
+
for y = 0 to info.height - 1 do
543
+
let curr_row = Bytes.sub image.data (y * row_bytes) row_bytes in
544
+
545
+
let (filter, filtered) = match filter_strategy with
546
+
| `Adaptive ->
547
+
Filter.select_best_filter ~prev:!prev_row ~curr:curr_row ~bpp
548
+
| `Fixed f ->
549
+
Filter.filter_row f ~prev:!prev_row ~curr:curr_row ~output:filter_output ~bpp;
550
+
(f, filter_output)
551
+
in
552
+
553
+
let out_pos = y * (1 + row_bytes) in
554
+
Bytes.set_uint8 output out_pos (Filter.to_byte filter);
555
+
Bytes.blit filtered 0 output (out_pos + 1) row_bytes;
556
+
prev_row := curr_row
557
+
done;
558
+
output
559
+
| Adam7 ->
560
+
raise (Png_error (Unsupported "Adam7 encoding not yet implemented"))
561
+
in
562
+
563
+
(* Compress using decompress (zlib) Higher API *)
564
+
let compressed =
565
+
try
566
+
let str = Bytes.to_string filtered_data in
567
+
let i = De.bigstring_create De.io_buffer_size in
568
+
let o = De.bigstring_create De.io_buffer_size in
569
+
let w = De.Lz77.make_window ~bits:15 in
570
+
let q = De.Queue.create 0x1000 in
571
+
let r = Buffer.create (Bytes.length filtered_data) in
572
+
let p = ref 0 in
573
+
let refill buf =
574
+
let len = min (String.length str - !p) De.io_buffer_size in
575
+
Bigstringaf.blit_from_string str ~src_off:!p buf ~dst_off:0 ~len;
576
+
p := !p + len;
577
+
len
578
+
in
579
+
let flush buf len =
580
+
let s = Bigstringaf.substring buf ~off:0 ~len in
581
+
Buffer.add_string r s
582
+
in
583
+
Zl.Higher.compress ~level:compression ~dynamic:true ~w ~q ~refill ~flush i o;
584
+
Bytes.of_string (Buffer.contents r)
585
+
with e ->
586
+
raise (Png_error (Decompression_error ("Compression failed: " ^ Printexc.to_string e)))
587
+
in
588
+
589
+
(* Write IDAT chunks (split at 8KB boundaries) *)
590
+
let idat_chunk_size = 8192 in
591
+
let compressed_len = Bytes.length compressed in
592
+
let rec write_idat pos =
593
+
if pos < compressed_len then begin
594
+
let chunk_len = min idat_chunk_size (compressed_len - pos) in
595
+
let chunk_data = Bytes.sub compressed pos chunk_len in
596
+
write_chunk chunks Chunk.idat chunk_data;
597
+
write_idat (pos + chunk_len)
598
+
end
599
+
in
600
+
write_idat 0;
601
+
602
+
(* Write IEND *)
603
+
write_chunk chunks Chunk.iend Bytes.empty;
604
+
605
+
(* Combine signature + chunks *)
606
+
let chunks = List.rev !chunks in
607
+
let total_len = 8 + List.fold_left (fun acc c -> acc + Bytes.length c) 0 chunks in
608
+
let output = Bytes.create total_len in
609
+
Bytes.blit_string signature 0 output 0 8;
610
+
let _ = List.fold_left (fun pos c ->
611
+
Bytes.blit c 0 output pos (Bytes.length c);
612
+
pos + Bytes.length c
613
+
) 8 chunks in
614
+
output
615
+
616
+
(** Encode image to PNG file. *)
617
+
let encode_file ?compression ?filter_strategy image filename =
618
+
let data = encode ?compression ?filter_strategy image in
619
+
let oc = open_out_bin filename in
620
+
output_bytes oc data;
621
+
close_out oc
622
+
623
+
(** {1 Utilities} *)
624
+
625
+
(** Create a simple info structure. *)
626
+
let make_info ~width ~height ?(bit_depth=Eight) ?(color_type=RGBA) () =
627
+
{
628
+
width;
629
+
height;
630
+
bit_depth;
631
+
color_type;
632
+
interlace = No_interlace;
633
+
palette = None;
634
+
trns = None;
635
+
gamma = None;
636
+
srgb = None;
637
+
chrm = None;
638
+
bkgd = None;
639
+
phys = None;
640
+
}
641
+
642
+
(** Create an image from raw pixel data. *)
643
+
let make_image ~info ~data =
644
+
let expected = bytes_per_row info.width info.color_type info.bit_depth * info.height in
645
+
if Bytes.length data <> expected then
646
+
invalid_arg (Printf.sprintf "make_image: data length %d, expected %d"
647
+
(Bytes.length data) expected);
648
+
{ info; data }
+332
vendor/opam/ocaml-png/src/png.mli
+332
vendor/opam/ocaml-png/src/png.mli
···
1
+
(** {1 OCaml PNG Library}
2
+
3
+
A pure OCaml implementation of PNG (Portable Network Graphics) encoding
4
+
and decoding, based on the {{:https://www.w3.org/TR/png/} W3C PNG
5
+
Specification (Third Edition)}.
6
+
7
+
{2 Overview}
8
+
9
+
This library provides:
10
+
- Decoding of PNG images to raw pixel data
11
+
- Encoding of raw pixel data to PNG format
12
+
- Support for all standard color types and bit depths
13
+
- Adam7 interlace decoding
14
+
- Adaptive filter selection for optimal compression
15
+
16
+
{2 Quick Start}
17
+
18
+
{[
19
+
(* Decode a PNG file *)
20
+
let image = Png.decode_file "input.png"
21
+
22
+
(* Access image properties *)
23
+
let width = image.info.width
24
+
let height = image.info.height
25
+
26
+
(* Encode and save *)
27
+
Png.encode_file image "output.png"
28
+
]}
29
+
30
+
{2 References}
31
+
32
+
- {{:https://www.w3.org/TR/png/} W3C PNG Specification (Third Edition)}
33
+
- {{:https://www.w3.org/TR/png/#5Chunk-layout} Chunk Layout (Section 5)}
34
+
- {{:https://www.w3.org/TR/png/#9Filters} Filtering (Section 9)}
35
+
- {{:https://www.w3.org/TR/png/#8Interlace} Interlacing (Section 8)} *)
36
+
37
+
(** {1 Types} *)
38
+
39
+
(** Color type defines how pixel data is stored.
40
+
41
+
As defined in {{:https://www.w3.org/TR/png/#6Colour-values} PNG Spec
42
+
Section 6.1}, the color type is a single-byte integer that describes
43
+
the interpretation of the image data.
44
+
45
+
Valid combinations with bit depth are defined in
46
+
{{:https://www.w3.org/TR/png/#table111} Table 11.1}. *)
47
+
type color_type =
48
+
| Grayscale (** Color type 0: Each pixel is a grayscale sample *)
49
+
| RGB (** Color type 2: Each pixel is an R,G,B triple *)
50
+
| Indexed (** Color type 3: Each pixel is a palette index *)
51
+
| Grayscale_alpha (** Color type 4: Grayscale sample followed by alpha *)
52
+
| RGBA (** Color type 6: R,G,B triple followed by alpha *)
53
+
54
+
(** Bit depth specifies the number of bits per sample or palette index.
55
+
56
+
As defined in {{:https://www.w3.org/TR/png/#11IHDR} PNG Spec Section 11.2.2},
57
+
valid bit depths depend on the color type:
58
+
- Grayscale: 1, 2, 4, 8, 16
59
+
- RGB: 8, 16
60
+
- Indexed: 1, 2, 4, 8
61
+
- Grayscale+Alpha: 8, 16
62
+
- RGBA: 8, 16 *)
63
+
type bit_depth =
64
+
| One (** 1 bit per sample *)
65
+
| Two (** 2 bits per sample *)
66
+
| Four (** 4 bits per sample *)
67
+
| Eight (** 8 bits per sample *)
68
+
| Sixteen (** 16 bits per sample *)
69
+
70
+
(** Interlace method as defined in {{:https://www.w3.org/TR/png/#8Interlace}
71
+
PNG Spec Section 8}.
72
+
73
+
Adam7 interlacing allows progressive display of images by transmitting
74
+
pixels in 7 passes, each filling in more detail. *)
75
+
type interlace =
76
+
| No_interlace (** Method 0: No interlacing, pixels stored sequentially *)
77
+
| Adam7 (** Method 1: Adam7 interlacing with 7 passes *)
78
+
79
+
(** Image header information containing all metadata from IHDR and
80
+
ancillary chunks.
81
+
82
+
The core fields (width, height, bit_depth, color_type, interlace) come
83
+
from the IHDR chunk as specified in {{:https://www.w3.org/TR/png/#11IHDR}
84
+
PNG Spec Section 11.2.2}.
85
+
86
+
Optional fields come from ancillary chunks:
87
+
- [palette]: PLTE chunk ({{:https://www.w3.org/TR/png/#11PLTE} Section 11.2.3})
88
+
- [trns]: tRNS chunk ({{:https://www.w3.org/TR/png/#11tRNS} Section 11.3.2})
89
+
- [gamma]: gAMA chunk ({{:https://www.w3.org/TR/png/#11gAMA} Section 11.3.3})
90
+
- [srgb]: sRGB chunk ({{:https://www.w3.org/TR/png/#11sRGB} Section 11.3.4})
91
+
- [chrm]: cHRM chunk ({{:https://www.w3.org/TR/png/#11cHRM} Section 11.3.5})
92
+
- [bkgd]: bKGD chunk ({{:https://www.w3.org/TR/png/#11bKGD} Section 11.3.6})
93
+
- [phys]: pHYs chunk ({{:https://www.w3.org/TR/png/#11pHYs} Section 11.3.7}) *)
94
+
type info = {
95
+
width : int;
96
+
(** Image width in pixels (1 to 2^31-1) *)
97
+
98
+
height : int;
99
+
(** Image height in pixels (1 to 2^31-1) *)
100
+
101
+
bit_depth : bit_depth;
102
+
(** Number of bits per sample or palette index *)
103
+
104
+
color_type : color_type;
105
+
(** Defines how pixel values are interpreted *)
106
+
107
+
interlace : interlace;
108
+
(** Interlacing method used *)
109
+
110
+
palette : bytes option;
111
+
(** PLTE: Color palette for indexed images. Contains 1-256 RGB entries
112
+
(3 bytes each). Required for color type 3. *)
113
+
114
+
trns : bytes option;
115
+
(** tRNS: Transparency information.
116
+
- Grayscale: 2 bytes (gray value)
117
+
- RGB: 6 bytes (RGB value)
118
+
- Indexed: 0-256 bytes (alpha for each palette entry) *)
119
+
120
+
gamma : float option;
121
+
(** gAMA: Image gamma value. Stored as gamma * 100000 in PNG. *)
122
+
123
+
srgb : int option;
124
+
(** sRGB: Rendering intent (0-3). Indicates image uses sRGB color space. *)
125
+
126
+
chrm : (int * int * int * int * int * int * int * int) option;
127
+
(** cHRM: Chromaticity values (white_x, white_y, red_x, red_y,
128
+
green_x, green_y, blue_x, blue_y) scaled by 100000. *)
129
+
130
+
bkgd : bytes option;
131
+
(** bKGD: Background color for compositing. Format depends on color type. *)
132
+
133
+
phys : (int * int * int) option;
134
+
(** pHYs: Physical pixel dimensions (x_pixels_per_unit, y_pixels_per_unit,
135
+
unit_specifier). Unit 0 = unknown, 1 = meter. *)
136
+
}
137
+
138
+
(** A decoded PNG image containing header information and raw pixel data.
139
+
140
+
The [data] field contains uncompressed, unfiltered pixel data in
141
+
row-major order. For multi-byte samples, bytes are in big-endian order
142
+
as per {{:https://www.w3.org/TR/png/#7Integers-and-byte-order}
143
+
PNG Spec Section 7}. *)
144
+
type image = {
145
+
info : info;
146
+
(** Image metadata *)
147
+
148
+
data : bytes;
149
+
(** Raw pixel data in row-major order. Size is
150
+
[height * bytes_per_row width color_type bit_depth]. *)
151
+
}
152
+
153
+
(** {1 Errors} *)
154
+
155
+
(** Errors that can occur during PNG processing. *)
156
+
type error =
157
+
| Invalid_signature
158
+
(** PNG signature (first 8 bytes) is incorrect.
159
+
See {{:https://www.w3.org/TR/png/#5PNG-file-signature} Section 5.2}. *)
160
+
161
+
| Invalid_ihdr
162
+
(** IHDR chunk is missing, malformed, or not first chunk. *)
163
+
164
+
| Invalid_chunk_crc
165
+
(** CRC32 checksum of chunk does not match stored value.
166
+
See {{:https://www.w3.org/TR/png/#5CRC-algorithm} Section 5.5}. *)
167
+
168
+
| Invalid_chunk_length
169
+
(** Chunk length is negative or exceeds file bounds. *)
170
+
171
+
| Invalid_filter of int
172
+
(** Unknown filter type byte (valid: 0-4).
173
+
See {{:https://www.w3.org/TR/png/#9Filter-types} Section 9.2}. *)
174
+
175
+
| Invalid_color_type of int
176
+
(** Unknown color type (valid: 0, 2, 3, 4, 6). *)
177
+
178
+
| Invalid_bit_depth of int
179
+
(** Invalid bit depth for the color type. *)
180
+
181
+
| Invalid_interlace of int
182
+
(** Unknown interlace method (valid: 0, 1). *)
183
+
184
+
| Unsupported of string
185
+
(** Feature is not supported (e.g., Adam7 encoding). *)
186
+
187
+
| Truncated
188
+
(** Unexpected end of data. *)
189
+
190
+
| Decompression_error of string
191
+
(** Zlib decompression failed. *)
192
+
193
+
(** Exception raised for PNG processing errors. *)
194
+
exception Png_error of error
195
+
196
+
(** Convert an error to a human-readable string. *)
197
+
val string_of_error : error -> string
198
+
199
+
(** Pretty-printer for errors (for use with [Format]). *)
200
+
val pp_error : Format.formatter -> error -> unit
201
+
202
+
(** {1 Decoding}
203
+
204
+
PNG decoding follows the process defined in
205
+
{{:https://www.w3.org/TR/png/#4Concepts} PNG Spec Section 4}:
206
+
1. Validate PNG signature
207
+
2. Parse IHDR chunk
208
+
3. Collect and decompress IDAT chunks
209
+
4. Apply inverse filtering to each row
210
+
5. Handle interlacing if present *)
211
+
212
+
(** Decode a PNG image from bytes.
213
+
214
+
@param bytes Raw PNG file data
215
+
@return Decoded image with pixel data
216
+
@raise Png_error if the data is not a valid PNG *)
217
+
val decode : bytes -> image
218
+
219
+
(** Decode a PNG image from a file.
220
+
221
+
@param filename Path to PNG file
222
+
@return Decoded image with pixel data
223
+
@raise Png_error if the file is not a valid PNG
224
+
@raise Sys_error if file cannot be opened *)
225
+
val decode_file : string -> image
226
+
227
+
(** {1 Encoding}
228
+
229
+
PNG encoding follows the process defined in
230
+
{{:https://www.w3.org/TR/png/#4Concepts} PNG Spec Section 4}:
231
+
1. Write PNG signature
232
+
2. Write IHDR chunk
233
+
3. Write ancillary chunks (PLTE, tRNS, gAMA, etc.)
234
+
4. Apply filtering to each row
235
+
5. Compress filtered data with zlib
236
+
6. Write IDAT chunks
237
+
7. Write IEND chunk *)
238
+
239
+
(** Encode an image to PNG bytes.
240
+
241
+
@param compression Zlib compression level (0-9, default 6)
242
+
@param filter_strategy Filter selection strategy:
243
+
- [`Adaptive]: Try all filters, pick best (default)
244
+
- [`Fixed f]: Use filter [f] for all rows
245
+
@param image Image to encode
246
+
@return PNG file data as bytes
247
+
@raise Png_error if encoding fails (e.g., Adam7 not supported) *)
248
+
val encode :
249
+
?compression:int ->
250
+
?filter_strategy:[`Adaptive | `Fixed of Filter.t] ->
251
+
image -> bytes
252
+
253
+
(** Encode an image and write to a file.
254
+
255
+
@param compression Zlib compression level (0-9, default 6)
256
+
@param filter_strategy Filter selection strategy
257
+
@param image Image to encode
258
+
@param filename Output file path
259
+
@raise Png_error if encoding fails
260
+
@raise Sys_error if the file cannot be written *)
261
+
val encode_file :
262
+
?compression:int ->
263
+
?filter_strategy:[`Adaptive | `Fixed of Filter.t] ->
264
+
image -> string -> unit
265
+
266
+
(** {1 Utilities} *)
267
+
268
+
(** Create an image info structure with default values.
269
+
270
+
@param width Image width in pixels
271
+
@param height Image height in pixels
272
+
@param bit_depth Bit depth (default: [Eight])
273
+
@param color_type Color type (default: [RGBA])
274
+
@return Info structure with no ancillary data *)
275
+
val make_info :
276
+
width:int ->
277
+
height:int ->
278
+
?bit_depth:bit_depth ->
279
+
?color_type:color_type ->
280
+
unit -> info
281
+
282
+
(** Create an image from info and raw pixel data.
283
+
284
+
@param info Image metadata
285
+
@param data Raw pixel data (must match expected size)
286
+
@return Complete image structure
287
+
@raise Invalid_argument if data size does not match expected dimensions *)
288
+
val make_image : info:info -> data:bytes -> image
289
+
290
+
(** {2 Pixel Format Helpers} *)
291
+
292
+
(** Number of samples per pixel for the given color type.
293
+
294
+
- Grayscale: 1
295
+
- RGB: 3
296
+
- Indexed: 1
297
+
- Grayscale+Alpha: 2
298
+
- RGBA: 4 *)
299
+
val samples_per_pixel : color_type -> int
300
+
301
+
(** Bytes per pixel for filtering purposes.
302
+
303
+
For sub-byte pixels (bit depth < 8), returns 1.
304
+
Otherwise returns [samples_per_pixel * bit_depth / 8]. *)
305
+
val bytes_per_pixel : color_type -> bit_depth -> int
306
+
307
+
(** Bytes per row of pixel data (excluding filter byte).
308
+
309
+
Calculated as: [(width * samples * bit_depth + 7) / 8] *)
310
+
val bytes_per_row : int -> color_type -> bit_depth -> int
311
+
312
+
(** Check if a color type / bit depth combination is valid per PNG spec.
313
+
314
+
See {{:https://www.w3.org/TR/png/#table111} Table 11.1}. *)
315
+
val is_valid_combination : color_type -> bit_depth -> bool
316
+
317
+
(** {2 Type Conversions} *)
318
+
319
+
(** Convert integer to color type. Returns [None] for invalid values. *)
320
+
val color_type_of_int : int -> color_type option
321
+
322
+
(** Convert color type to its integer representation. *)
323
+
val int_of_color_type : color_type -> int
324
+
325
+
(** Convert integer to bit depth. Returns [None] for invalid values. *)
326
+
val bit_depth_of_int : int -> bit_depth option
327
+
328
+
(** Convert bit depth to its integer representation. *)
329
+
val int_of_bit_depth : bit_depth -> int
330
+
331
+
(** Convert integer to interlace method. Returns [None] for invalid values. *)
332
+
val interlace_of_int : int -> interlace option
+57
vendor/opam/ocaml-png/test/debug.ml
+57
vendor/opam/ocaml-png/test/debug.ml
···
1
+
let deflate_string ?(level=6) str =
2
+
let i = De.bigstring_create De.io_buffer_size in
3
+
let o = De.bigstring_create De.io_buffer_size in
4
+
let w = De.Lz77.make_window ~bits:15 in
5
+
let q = De.Queue.create 0x1000 in
6
+
let r = Buffer.create 0x1000 in
7
+
let p = ref 0 in
8
+
let refill buf =
9
+
let len = min (String.length str - !p) De.io_buffer_size in
10
+
Bigstringaf.blit_from_string str ~src_off:!p buf ~dst_off:0 ~len;
11
+
p := !p + len;
12
+
len
13
+
in
14
+
let flush buf len =
15
+
let s = Bigstringaf.substring buf ~off:0 ~len in
16
+
Buffer.add_string r s
17
+
in
18
+
Zl.Higher.compress ~level ~dynamic:true ~w ~q ~refill ~flush i o;
19
+
Buffer.contents r
20
+
21
+
let inflate_string str =
22
+
let i = De.bigstring_create De.io_buffer_size in
23
+
let o = De.bigstring_create De.io_buffer_size in
24
+
let allocate bits = De.make_window ~bits in
25
+
let r = Buffer.create 0x1000 in
26
+
let p = ref 0 in
27
+
let refill buf =
28
+
let len = min (String.length str - !p) De.io_buffer_size in
29
+
Bigstringaf.blit_from_string str ~src_off:!p buf ~dst_off:0 ~len;
30
+
p := !p + len;
31
+
len
32
+
in
33
+
let flush buf len =
34
+
let s = Bigstringaf.substring buf ~off:0 ~len in
35
+
Buffer.add_string r s
36
+
in
37
+
match Zl.Higher.uncompress ~allocate ~refill ~flush i o with
38
+
| Ok () -> Ok (Buffer.contents r)
39
+
| Error _ as err -> err
40
+
41
+
let () =
42
+
let test_data = "Hello, this is a test of the zlib compression. Let's make it longer to test properly!" in
43
+
Printf.printf "Original: %d bytes\n%!" (String.length test_data);
44
+
45
+
let compressed = deflate_string test_data in
46
+
Printf.printf "Compressed: %d bytes\n%!" (String.length compressed);
47
+
48
+
match inflate_string compressed with
49
+
| Ok recovered ->
50
+
Printf.printf "Recovered: %d bytes\n%!" (String.length recovered);
51
+
Printf.printf "Match: %b\n%!" (test_data = recovered);
52
+
if test_data = recovered then
53
+
Printf.printf "SUCCESS!\n%!"
54
+
else
55
+
Printf.printf "Data mismatch!\n%!"
56
+
| Error (`Msg msg) ->
57
+
Printf.printf "Error: %s\n%!" msg
+13
vendor/opam/ocaml-png/test/dune
+13
vendor/opam/ocaml-png/test/dune
···
1
+
(test
2
+
(name test_png)
3
+
(libraries png alcotest)
4
+
(deps (source_tree ../vendor/git/image-png/tests/pngsuite)))
5
+
6
+
(rule
7
+
(alias debug)
8
+
(deps debug.exe (source_tree ../vendor/git/image-png/tests/pngsuite))
9
+
(action (run %{exe:debug.exe})))
10
+
11
+
(executable
12
+
(name debug)
13
+
(libraries png))
+96
vendor/opam/ocaml-png/test/test_png.ml
+96
vendor/opam/ocaml-png/test/test_png.ml
···
1
+
(** PNG Test Suite *)
2
+
3
+
open Alcotest
4
+
5
+
(** Test CRC32 implementation *)
6
+
let test_crc32 () =
7
+
let crc = Crc32.compute_string "123456789" in
8
+
check int32 "CRC32 of '123456789'" 0xCBF43926l crc
9
+
10
+
let test_crc32_empty () =
11
+
let crc = Crc32.compute_bytes Bytes.empty in
12
+
check int32 "CRC32 of empty" 0x00000000l crc
13
+
14
+
(** Test basic PNG decoding *)
15
+
let pngsuite_dir = "vendor/git/image-png/tests/pngsuite"
16
+
17
+
let test_decode_file filename () =
18
+
let path = Filename.concat pngsuite_dir filename in
19
+
try
20
+
let img = Png.decode_file path in
21
+
check bool "Image decoded" true (img.info.width > 0 && img.info.height > 0)
22
+
with
23
+
| Png.Png_error e ->
24
+
(* Some test files are intentionally corrupted *)
25
+
if String.length filename > 0 && filename.[0] = 'x' then
26
+
(* x* files are corrupt test cases, expected to fail *)
27
+
()
28
+
else
29
+
fail (Png.string_of_error e)
30
+
| e ->
31
+
fail (Printexc.to_string e)
32
+
33
+
let test_roundtrip filename () =
34
+
let path = Filename.concat pngsuite_dir filename in
35
+
try
36
+
let img = Png.decode_file path in
37
+
(* Encode and decode again *)
38
+
let encoded = Png.encode img in
39
+
let img2 = Png.decode encoded in
40
+
(* Compare dimensions and data *)
41
+
check int "Width matches" img.info.width img2.info.width;
42
+
check int "Height matches" img.info.height img2.info.height;
43
+
check bytes "Data matches" img.data img2.data
44
+
with
45
+
| Png.Png_error (Png.Unsupported _) ->
46
+
(* Skip unsupported features like Adam7 encoding *)
47
+
()
48
+
| Png.Png_error e ->
49
+
if String.length filename > 0 && filename.[0] = 'x' then ()
50
+
else fail (Printf.sprintf "%s: %s" filename (Png.string_of_error e))
51
+
| e ->
52
+
fail (Printf.sprintf "%s: %s" filename (Printexc.to_string e))
53
+
54
+
(** Get all PNG files in pngsuite *)
55
+
let get_pngsuite_files () =
56
+
let dir = pngsuite_dir in
57
+
if Sys.file_exists dir && Sys.is_directory dir then
58
+
let files = Sys.readdir dir in
59
+
Array.to_list files
60
+
|> List.filter (fun f -> Filename.extension f = ".png")
61
+
|> List.sort String.compare
62
+
else
63
+
[]
64
+
65
+
(** Create decode tests for all pngsuite files *)
66
+
let pngsuite_decode_tests =
67
+
let files = get_pngsuite_files () in
68
+
List.map (fun f ->
69
+
test_case f `Quick (test_decode_file f)
70
+
) files
71
+
72
+
(** Create roundtrip tests for basic files (non-interlaced, non-corrupt).
73
+
Skip corrupt files (starting with x) and interlaced files (starting with basi). *)
74
+
let pngsuite_roundtrip_tests =
75
+
let files = get_pngsuite_files () in
76
+
let is_basic f =
77
+
let len = String.length f in
78
+
let not_corrupt = len = 0 || f.[0] <> 'x' in
79
+
let not_interlaced = len < 4 || String.sub f 0 4 <> "basi" in
80
+
not_corrupt && not_interlaced
81
+
in
82
+
files
83
+
|> List.filter is_basic
84
+
|> List.map (fun f ->
85
+
test_case f `Quick (test_roundtrip f)
86
+
)
87
+
88
+
let () =
89
+
run "PNG" [
90
+
"crc32", [
91
+
test_case "standard test vector" `Quick test_crc32;
92
+
test_case "empty" `Quick test_crc32_empty;
93
+
];
94
+
"pngsuite decode", pngsuite_decode_tests;
95
+
"pngsuite roundtrip", pngsuite_roundtrip_tests;
96
+
]