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