(* A simple gray-image processing library A simpler and more elegant version of http://okmij.org/ftp/Graphics.html#cpp.improc *) (* An image is a pixel map, a matrix of pixels arranged row-by-row. Each pixel specifies the gray level at a particular point. A row or a column index always starts with 0. For simplicity we assume the image depth to be 8 (that is, the pixel range [0..255]) *) open Bigarray type pixel = int type img = (int,int8_unsigned_elt,c_layout) Array2.t let ncols : img -> int = Array2.dim2 (* Image width in pixels *) let nrows : img -> int = Array2.dim1 (* Image height in pixels *) (* A view: All pixels, in row major order *) let pixels : img -> (int,int8_unsigned_elt,c_layout) Array1.t = fun img -> let npixels = Array2.dim1 img * Array2.dim2 img in reshape_1 (genarray_of_array2 img) npixels (* Iterate over all pixels, in row major order *) let iter : (pixel -> unit) -> img -> unit = fun f img -> let npixels = Array2.dim1 img * Array2.dim2 img in let img1 = reshape_1 (genarray_of_array2 img) npixels in for i = 0 to npixels-1 do f img1.{i} done (* Read an image from a Portable GrayMap (pgm) file The program reads a "binary" (RAWBITS) pgm file of the following format - A "magic number" for identifying the file type. A pgm file's RAWBITS magic number is the two characters "P5". - Whitespace (blanks, TABs, CRs, LFs). - A width, formatted as ASCII characters in decimal. - Whitespace. - A height, again in ASCII decimal. - Whitespace. - The maximum gray value, again in ASCII decimal. For RAWBITS pgm file the maximum grayscale value cannot exceed 255. - A _single_ character of whitespace (typically a newline). - Width * height gray values, each as plain bytes, between 0 and the specified maximum value, stored consecutively, starting at the top-left corner of the graymap, proceeding in normal English reading order. A value of 0 means black, and the maximum value means white. For more detail, see documentation on PBMPLUS package (specifically, pgm(5)). *) (* This function uses scanf to parse the header, and low-level really_input to read the body of the image. In OCaml, mixing the low-level and the formatted input is very error-prone. The formatted input reads by 1024-byte chunks. Therefore, we create our own formatted buffer (and hope there is no look-ahead). *) let read_pgm : string -> img = let allocate cin = (* read header, allocate image *) let alloc ncols nrows = Printf.printf "Reading image %dx%d...\n" nrows ncols; Array2.create int8_unsigned c_layout nrows ncols in Scanf.bscanf (Scanf.Scanning.from_function (fun () -> input_char cin)) "P5 %u %u %u%c" (fun ncols nrows maxgray term -> if not (term = ' ' || term = '\n' || term = '\t') then failwith ("Could not find the single terminating whitespace " ^ "at the end of the header"); if maxgray > 255 || maxgray <= 0 then failwith (Printf.sprintf "maxgray %d is odd or unsupported" maxgray); alloc ncols nrows) in let read_data cin img = let nrows = Array2.dim1 img and ncols = Array2.dim2 img in let buf = Bytes.make ncols '\000' in (* a scanline *) for i = 0 to nrows - 1 do really_input cin buf 0 ncols; let scanline = Array2.slice_left img i in for j = 0 to ncols - 1 do scanline.{j} <- Char.code (Bytes.get buf j) done done; img in let load cin = read_data cin (allocate cin) in fun fname -> let cin = open_in_bin fname in let r = try load cin with e -> close_in cin; raise e in close_in cin; r (* Write the image to the specified file in the PGM binary format *) let write_pgm : string -> img -> unit = fun fname img -> let cout = open_out fname in try Printf.fprintf cout "P5\n%d %d\n255\n" (ncols img) (nrows img); let pxs = pixels img in for i = 0 to Array1.dim pxs - 1 do output_byte cout (Array1.unsafe_get pxs i) done; close_out cout with e -> close_out cout; raise e (* Display the image with a particular command. The command should take the name of the image file, in PGM, as the argument. *) let display : ?cmd:string -> img -> unit = fun ?(cmd:string="xli") img -> let fname = Filename.temp_file "img" ".pgm" in write_pgm fname img; ignore (Sys.command (cmd ^ " " ^ fname)); Sys.remove fname