Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

89 lines (76 sloc) 2.045 kB
(* Dimensions d'une image *)
let get_dims img =
((Sdlvideo.surface_info img).Sdlvideo.w, (Sdlvideo.surface_info img).Sdlvideo.h)
(* attendre une touche ... *)
let rec wait_key () =
let e = Sdlevent.wait_event () in
match e with
Sdlevent.KEYDOWN _ -> ()
| _ -> wait_key ()
(* init de SDL *)
let sdl_init () =
begin
Sdl.init [`EVERYTHING];
Sdlevent.enable_events Sdlevent.all_events_mask;
end
(*
show img dst
affiche la surface img sur la surface de destination dst (normalement l'écran)
*)
let show img dst =
let d = Sdlvideo.display_format img in
Sdlvideo.blit_surface d dst ();
Sdlvideo.flip dst
(* level *)
let level (r,g,b) =
(0.3 *. (float)r +. 0.59 *. (float)g +. 0.11 *. (float)b) /. 255.
(* color2grey *)
let color2grey (r,g,b) =
let px = int_of_float(level(r,g,b)*.255.) in
(px,px,px)
(* image2grey *)
let image2grey src dst =
let (w,h) = get_dims src in
for x = 0 to w do
for y = 0 to h do
Sdlvideo.put_pixel_color(dst x y
(color2grey (Sdlvideo.get_pixel_color src x y)))
done
done
(* img2mtx *)
let img2mtx img w h =
let mtx = Array.make_matrix w h (0,0,0) in
for c = 0 to h do
for l = 0 to w do
mtx.(l).(c) <- Sdlvideo.get_pixel_color img c l
done
done;
mtx
(* mtx2img *)
let mtx2img mtx w h =
let img = Sdlvideo.create_RGB_surface_format Sdlloader.load_image Sys.argv.(1) [] w h in
for c = 0 to h do
for l = 0 to w do
Sdlvideo.put_pixel_color(img c l mtx.(l).(c))
done
done;
img
(* main *)
let main () =
begin
if Array.length (Sys.argv) < 2 then
failwith "Aucun fichier à charger";
sdl_init ();
let img = Sdlloader.load_image Sys.argv.(1) in
let (w,h) = get_dims img in
let display = Sdlvideo.set_video_mode w h [`DOUBLEBUF] in
show mtx2img(img2mtx(img)) display;
wait_key ();
(*
let grey = Sdlvideo.create_RGB_surface_format img [] w h in
image2grey img grey;
show grey display;
wait_key ();*)
exit 0
end
let _ = main ()
Jump to Line
Something went wrong with that request. Please try again.