| /trunk/gfx/save_bitmap/ocaml/tga.ml r10 | /trunk/gfx/save_bitmap/ocaml/tga.ml r12 | ||
| 1 | 1 | ||
|---|---|---|---|
| 2 | (** Save a Targa (.tga) file to chnl. *) | 2 | (** Save a Targa (.tga) file to chnl. *) |
| 3 | let write_tga_chnl chnl pixels w h = | 3 | let write_tga_chnl chnl pixels w h = |
| 4 | let header = | 4 | let header = |
| 5 | [0; 0; 2; 0; 0; 0; 0; 0; 0; 0; 0; 0; | 5 | [0; 0; 2; 0; 0; 0; 0; 0; 0; 0; 0; 0; |
| 6 | w land 255; w lsr 8; | 6 | w land 255; w lsr 8; |
| 7 | h land 255; h lsr 8; 32; 8] in | 7 | h land 255; h lsr 8; 32; 8] in |
| 8 | assert (List.length header = 18); | 8 | assert (List.length header = 18); |
| 9 | List.iter (fun e -> output_byte chnl e) header; | 9 | List.iter (fun e -> output_byte chnl e) header; |
| 10 | for y = 0 to h-1 do | 10 | for y = 0 to h-1 do |
| 11 | for x = 0 to w-1 do | 11 | for x = 0 to w-1 do |
| 12 | let c = pixels.(x+y*w) in | 12 | let c = pixels.(x+(h-1-y)*w) in (* h-1-y = Flip image *) |
| 13 | output_byte chnl (c land 255); | 13 | output_byte chnl (c land 255); |
| 14 | output_byte chnl ((c lsr 8) land 255); | 14 | output_byte chnl ((c lsr 8) land 255); |
| 15 | output_byte chnl ((c lsr 16) land 255); | 15 | output_byte chnl ((c lsr 16) land 255); |
| 16 | output_byte chnl 255; | 16 | output_byte chnl 255; |
| 17 | done | 17 | done |
| 18 | done | 18 | done |
| 19 | 19 | ||
| 20 | (** Save a Targa (.tga) file to file `filename'. *) | 20 | (** Save a Targa (.tga) file to file `filename'. *) |
| 21 | let write_tga filename pixels w h = | 21 | let write_tga filename pixels w h = |
| 22 | let chnl = open_out_bin filename in | 22 | let chnl = open_out_bin filename in |
| 23 | try | 23 | try |
| 24 | write_tga_chnl chnl pixels w h; | 24 | write_tga_chnl chnl pixels w h; |
| 25 | close_out chnl | 25 | close_out chnl |
| 26 | with | 26 | with |
| 27 | _ -> | 27 | _ -> |
| 28 | close_out chnl | 28 | close_out chnl |
