Fix corner case
[llpp.git] / lablGL / glPix.ml
blobdd5cd7d10798e3a8514b72d4a16f45dd07dd7f0a
1 (* $Id: glPix.ml,v 1.10 2005-10-14 13:35:32 garrigue Exp $ *)
3 open Gl
5 type ('a,'b) t = { format: 'a ; width: int ; height:int ; raw: 'b Raw.t }
7 let create k ~format ~width ~height =
8 let size = format_size format * width * height in
9 let len = match k with `bitmap -> (size-1)/8+1 | #Gl.real_kind -> size in
10 let raw = Raw.create k ~len in
11 { format = format; width = width; height = height; raw = raw }
13 let of_raw raw ~format ~width ~height =
14 let size = format_size format * width * height
15 and len = Raw.length raw in
16 let len =
17 match Raw.kind raw with `bitmap -> len * 8 | #Gl.real_kind -> len in
18 if size > len then invalid_arg "GlPix.of_raw";
19 { format = format; width = width; height = height; raw = raw }
21 let to_raw img = img.raw
22 let format img = img.format
23 let width img = img.width
24 let height img = img.height
26 let raw_pos img =
27 let width =
28 match Raw.kind img.raw with `bitmap -> (img.width-1)/8+1
29 | #Gl.real_kind -> img.width
31 let stride = format_size img.format in
32 let line = stride * width in
33 fun ~x ~y -> x * stride + y * line
35 external bitmap :
36 width:int -> height:int -> orig:point2 -> move:point2 ->
37 [`bitmap] Raw.t -> unit
38 = "ml_glBitmap"
39 type bitmap = ([`color_index], [`bitmap]) t
40 let bitmap (img : bitmap) =
41 bitmap ~width:img.width ~height:img.height img.raw
43 external copy :
44 x:int -> y:int -> width:int -> height:int ->
45 buffer:[`color|`depth|`stencil] -> unit
46 = "ml_glCopyPixels"
48 external draw :
49 width:int -> height:int -> format:[< format] -> [< Gl.kind] Raw.t -> unit
50 = "ml_glDrawPixels"
51 let draw img =
52 draw img.raw ~width:img.width ~height:img.height ~format:img.format
54 type map =
55 [`i_to_i|`i_to_r|`i_to_g|`i_to_b|`i_to_a
56 |`s_to_s|`r_to_r|`g_to_g|`b_to_b|`a_to_a]
57 external map : map -> [`float] Raw.t -> unit
58 = "ml_glPixelMapfv"
60 type store_param = [
61 `pack_swap_bytes of bool
62 | `pack_lsb_first of bool
63 | `pack_row_length of int
64 | `pack_skip_pixels of int
65 | `pack_skip_rows of int
66 | `pack_alignment of int
67 | `unpack_swap_bytes of bool
68 | `unpack_lsb_first of bool
69 | `unpack_row_length of int
70 | `unpack_skip_pixels of int
71 | `unpack_skip_rows of int
72 | `unpack_alignment of int
74 external store : store_param -> unit = "ml_glPixelStorei"
76 type transfer_param = [
77 `map_color of bool
78 | `map_stencil of bool
79 | `index_shift of int
80 | `index_offset of int
81 | `red_scale of float
82 | `red_bias of float
83 | `green_scale of float
84 | `green_bias of float
85 | `blue_scale of float
86 | `blue_bias of float
87 | `alpha_scale of float
88 | `alpha_bias of float
89 | `depth_scale of float
90 | `depth_bias of float
92 external transfer : transfer_param -> unit = "ml_glPixelTransfer"
94 external zoom : x:float -> y:float -> unit = "ml_glPixelZoom"
96 external raster_pos :
97 x:float -> y:float -> ?z:float -> ?w:float -> unit -> unit
98 = "ml_glRasterPos"
100 external read :
101 x:int -> y:int -> width:int -> height:int ->
102 format:[< format] -> [< Gl.kind] Raw.t -> unit
103 = "ml_glReadPixels_bc" "ml_glReadPixels"
104 let read ~x ~y ~width ~height ~format ~kind =
105 let raw = Raw.create kind ~len:(width * height * format_size format) in
106 read ~x ~y ~width ~height ~format raw;
107 { raw = raw; width = width; height = height; format = format }