143 lines
3.8 KiB
OCaml
143 lines
3.8 KiB
OCaml
external rawget : string -> string
|
|
= "camltk_getimgdata"
|
|
external rawset : string -> string -> int -> int -> int -> int -> unit
|
|
= "camltk_setimgdata_bytecode" (* all int parameters MUST be positive *)
|
|
"camltk_setimgdata_native"
|
|
|
|
type t = {
|
|
pixmap_width : int;
|
|
pixmap_height: int;
|
|
pixmap_data: string
|
|
}
|
|
|
|
type pixel = string (* 3 chars *)
|
|
|
|
(* pixmap will be an abstract type *)
|
|
let width pix = pix.pixmap_width
|
|
let height pix = pix.pixmap_height
|
|
|
|
|
|
(* note: invalid size would have been caught by String.create, but we put
|
|
* it here for documentation purpose *)
|
|
let create w h =
|
|
if w < 0 || h < 0 then invalid_arg "invalid size"
|
|
else {
|
|
pixmap_width = w;
|
|
pixmap_height = h;
|
|
pixmap_data = String.create (w * h * 3);
|
|
}
|
|
|
|
(*
|
|
* operations on pixmaps
|
|
*)
|
|
let unsafe_copy pix_from pix_to =
|
|
String.unsafe_blit pix_from.pixmap_data 0
|
|
pix_to.pixmap_data 0
|
|
(String.length pix_from.pixmap_data)
|
|
|
|
(* We check only the length. w,h might be different... *)
|
|
let copy pix_from pix_to =
|
|
let l = String.length pix_from.pixmap_data in
|
|
if l <> String.length pix_to.pixmap_data then
|
|
raise (Invalid_argument "copy: incompatible length")
|
|
else unsafe_copy pix_from pix_to
|
|
|
|
|
|
(* Pixel operations *)
|
|
let unsafe_get_pixel pixmap x y =
|
|
let pos = (y * pixmap.pixmap_width + x) * 3 in
|
|
let r = String.create 3 in
|
|
String.unsafe_blit pixmap.pixmap_data pos r 0 3;
|
|
r
|
|
|
|
let unsafe_set_pixel pixmap x y pixel =
|
|
let pos = (y * pixmap.pixmap_width + x) * 3 in
|
|
String.unsafe_blit pixel 0 pixmap.pixmap_data pos 3
|
|
|
|
(* To get safe operations, we can either check x,y wrt [0,w[ and [0,h[
|
|
or rely on blit checking. We choose the first for clarity.
|
|
*)
|
|
let get_pixel pix x y =
|
|
if x < 0 || y < 0 || x >= pix.pixmap_width || y >= pix.pixmap_height
|
|
then invalid_arg "invalid pixel"
|
|
else unsafe_get_pixel pix x y
|
|
|
|
(* same check (pixel being abstract, it must be of good size *)
|
|
let set_pixel pix x y pixel =
|
|
if x < 0 || y < 0 || x >= pix.pixmap_width || y >= pix.pixmap_height
|
|
then invalid_arg "invalid pixel"
|
|
else unsafe_set_pixel pix x y pixel
|
|
|
|
(* black as default_color, if at all needed *)
|
|
let default_color = "\000\000\000"
|
|
|
|
(* Char.chr does range checking *)
|
|
let pixel r g b =
|
|
let s = String.create 3 in
|
|
s.[0] <- Char.chr r;
|
|
s.[1] <- Char.chr g;
|
|
s.[2] <- Char.chr b;
|
|
s
|
|
|
|
##ifdef CAMLTK
|
|
|
|
(* create pixmap from an existing image *)
|
|
let get photo =
|
|
match photo with
|
|
| PhotoImage s -> {
|
|
pixmap_width = CImagephoto.width photo;
|
|
pixmap_height = CImagephoto.height photo;
|
|
pixmap_data = rawget s;
|
|
}
|
|
|
|
(* copy a full pixmap into an image *)
|
|
let set photo pix =
|
|
match photo with
|
|
| PhotoImage s ->
|
|
rawset s pix.pixmap_data 0 0 pix.pixmap_width pix.pixmap_height
|
|
|
|
(* general blit of pixmap into image *)
|
|
let blit photo pix x y w h =
|
|
if x < 0 || y < 0 || w < 0 || h < 0 then invalid_arg "negative argument"
|
|
else match photo with
|
|
| PhotoImage s ->
|
|
rawset s pix.pixmap_data x y w h
|
|
|
|
(* get from a file *)
|
|
let from_file filename =
|
|
let img = CImagephoto.create [File filename] in
|
|
let pix = get img in
|
|
CImagephoto.delete img;
|
|
pix
|
|
|
|
##else
|
|
|
|
(* create pixmap from an existing image *)
|
|
let get photo =
|
|
match photo with
|
|
| `Photo s -> {
|
|
pixmap_width = Imagephoto.width photo;
|
|
pixmap_height = Imagephoto.height photo;
|
|
pixmap_data = rawget s;
|
|
}
|
|
|
|
(* copy a full pixmap into an image *)
|
|
let set photo pix =
|
|
match photo with
|
|
| `Photo s -> rawset s pix.pixmap_data 0 0 pix.pixmap_width pix.pixmap_height
|
|
|
|
(* general blit of pixmap into image *)
|
|
let blit photo pix x y w h =
|
|
if x < 0 || y < 0 || w < 0 || h < 0 then invalid_arg "negative argument"
|
|
else match photo with
|
|
| `Photo s -> rawset s pix.pixmap_data x y w h
|
|
|
|
(* get from a file *)
|
|
let from_file filename =
|
|
let img = Imagephoto.create ~file: filename () in
|
|
let pix = get img in
|
|
Imagephoto.delete img;
|
|
pix
|
|
|
|
##endif
|