1:- module(image, [image_file/2]). 2
3:- use_module(library(clpfd)). 4
5:- use_module(bytes). 6:- use_module(utility). 7
9
10image_file(image(Format, Pixels), Path) :-
11 nonvar(Pixels) ->
12 open(Path, write, Stream, [type(binary)]),
13 write_image(Format, Stream, Pixels),
14 close(Stream);
15
16 file_format(Path, Format),
17 open(Path, read, Stream, [type(binary)]),
18 read_image(Format, Stream, Pixels),
19 close(Stream).
20
21write_image(bmp, Stream, Pixels) :-
22 length(Pixels, Height),
23 Pixels = [Row|_],
24 length(Row, Width),
25
26 Stride #= Width * 3 + (4 - (Width * 3) mod 4) mod 4,
27 FileSize #= 54 + 3 * Height * Stride,
28
29 reverse(Pixels, Reversed),
30 maplist(bmp_row, PixelData, Reversed),
31 maplist(pad_end(Stride, 0), PixelData, Padded),
32 flatten(Padded, Bytes),
33
34 byte_groups(Stream,
35 [
36 chars(2, ['B', 'M']), int(4, FileSize), int(4, 0), int(4, 54),
37 int(4, 40), int(4, Width), int(4, Height), int(2, 1),
38 int(2, 24), int(4, 0), int(4, 0), int(4, 0), int(4, 0),
39 int(4, 0), int(4, 0), bytes(Bytes)
40 ]).
41
42read_image(bmp, Stream, Pixels) :-
43 byte_groups(Stream,
44 [
45 bytes(2, _BM), int(4, _FileSize), bytes(4, _Reserved), int(4, Offset),
46 int(4, _HeaderSize), int(4, Width), int(4, _Height), bytes(24, _Information)
47 ]),
48
49 DataStart #= Offset - 54, % We've already read the 54 bytes for the header and information, so reduce the offset somewhat
50 byte_group(Stream, skip(DataStart)), % Skip some bytes
51
52 read_all_bytes(Stream, Bytes),
53 length(Bytes, L),
54 writeln(L),
55 read_bmp_rows(Width, Bytes, TempRows),
56 reverse(TempRows, Pixels).
57
58read_bmp_rows(_Width, [], []).
59read_bmp_rows(Width, Bytes, Rows) :-
60 Stride #= Width * 3 + (Width * 3 mod 4),
61 group(Stride, Bytes, Groups),
62 ByteLength #= Width * 3,
63 maplist(take(ByteLength), Groups, PixelData),
64 maplist(bmp_row, PixelData, Rows).
65
66bmp_row([], []).
67bmp_row([B,G,R|Bytes], [pixel(R, G, B) | Pixels]) :- bmp_row(Bytes, Pixels)