mandels_sdl.ml
(**************************************************************************)
(* Sample use of ParMap, a simple library to perform Map computations on *)
(* a multi-core *)
(* *)
(* Author(s): Marco Danelutto and Roberto Di Cosmo *)
(* *)
(* This program is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU General Public License as *)
(* published by the Free Software Foundation, either version 2 of the *)
(* License, or (at your option) any later version. *)
(**************************************************************************)
(* for the toplevel
#use "topfind";;
#require "graphics";;
#require "parmap";;
#require "sdl";;
*)
let ncores = ref 4;; (* how many core we use *)
let chunksize = ref 1;; (* granularity *)
let n = ref 1000;; (* the size of the square screen windows in pixels *)
let res = ref 1000;; (* the resolution: maximum number of iterations allowed *)
(* scale factor and offset of the picture *)
let scale = ref 1.;;
let ofx = ref 0.;;
let ofy = ref 0.;;
(* convert an integer in the range 0..res into a screen color *)
let color_of c res = truncate
(((float c)/.(float res))*.(float Graphics.white));;
(* compute the color of a pixel by iterating z_n+1=z_n^2+c *)
(* j,k are the pixel coordinates *)
let pixel (j,k,n) =
let zr = ref 0.0 in
let zi = ref 0.0 in
let cr = ref 0.0 in
let ci = ref 0.0 in
let zrs = ref 0.0 in
let zis = ref 0.0 in
let d = ref (2.0 /. ((float n) -. 1.0)) in
let colour = Array.make n (Graphics.black) in
for s = 0 to (n-1) do
let j1 = ref (((float j.(s)) +. !ofx) /. !scale) in
let k1 = ref (((float k) +. !ofy) /. !scale) in
begin
zr := !j1 *. !d -. 1.0;
zi := !k1 *. !d -. 1.0;
cr := !zr;
ci := !zi;
zrs := 0.0;
zis := 0.0;
for i=0 to (!res-1) do
begin
if(not((!zrs +. !zis) > 4.0))
then
begin
zrs := !zr *. !zr;
zis := !zi *. !zi;
zi := 2.0 *. !zr *. !zi +. !ci;
zr := !zrs -. !zis +. !cr;
Array.set colour s (color_of i !res);
end;
end
done
end
done;
(colour,k);;
(* generate the initial configuration *)
let initsegm n =
let rec aux acc = function 0 -> acc | n -> aux (n::acc) (n-1) in
aux [] n
;;
let tasks =
let ini = Array.make !n 0 in
let iniv =
for i=0 to (!n-1) do
Array.set ini i i
done; ini in
List.map (fun seed -> (iniv,seed,!n)) (initsegm !n)
;;
(* draw a line on the screen using fast image functions *)
let unpack_color n =
let r = (n land 0xff0000) lsr 16 and g = (n land 0x00ff00) lsr 8 and b = n land 0xff in
(r,g,b)
;;
let draw_line screen (col,j) =
Array.iteri
(fun i c -> Sdlvideo.put_pixel_color screen i j (unpack_color c))
col;;
let draw screen res = List.iter (fun c -> draw_line screen c) res;;
(* compute *)
let compute () =
let d = Unix.gettimeofday() in
let res =
if !ncores > 1 then
Parmap.parmap ~ncores: !ncores ~chunksize: !chunksize pixel (Parmap.L tasks)
else
List.map pixel tasks
in
Printf.eprintf " [time: %f] %!" (Unix.gettimeofday() -. d);
res
;;
(*** Open the main graphics window and run the event loop *)
open Sdlevent;;
open Sdlkey;;
open Sdlvideo;;
Sdl.init [`VIDEO];;
let (bpp, w, h) = (24, !n, !n);;
let screen = Sdlvideo.set_video_mode ~w ~h ~bpp [];;
(* two pixel deep surfaces for drawing and saving area borders *)
(* one pixel for each border: two horizontal and two vertical *)
let shadowh = Sdlvideo.create_RGB_surface_format screen [`SWSURFACE] ~w ~h:2;;
let shadowv = Sdlvideo.create_RGB_surface_format screen [`SWSURFACE] ~w:2 ~h;;
(* one pixel deep white surfaces for drawing area borders *)
let whiteh =
let surf = Sdlvideo.create_RGB_surface_format screen [`SWSURFACE] ~w ~h:1 in
for i = 0 to w-1 do Sdlvideo.put_pixel_color ~x:i ~y:0 surf Sdlvideo.white done;
surf;;
let whitev =
let surf = Sdlvideo.create_RGB_surface_format screen [`SWSURFACE] ~w:1 ~h in
for i = 0 to h-1 do Sdlvideo.put_pixel_color ~x:0 ~y:i surf Sdlvideo.white done;
surf;;
(* blit a rectangle border *)
type action = Draw | Save | Restore | Update;;
let border action x y w h =
let hrect1 = {r_x=x;r_y=y;r_w=w;r_h=1}
and vrect1 = {r_x=x;r_y=y;r_w=1;r_h=h}
and hrect2 = {r_x=x;r_y=y+h;r_w=w;r_h=1}
and vrect2 = {r_x=x+w;r_y=y;r_w=1;r_h=h}
in match action with
Draw ->
blit_surface ~src:whiteh ~src_rect:{hrect1 with r_y=0;r_h=1} ~dst:screen ~dst_rect:hrect1 ();
blit_surface ~src:whiteh ~src_rect:{hrect2 with r_y=0;r_h=1} ~dst:screen ~dst_rect:hrect2 ();
blit_surface ~src:whitev ~src_rect:{vrect1 with r_x=0;r_w=1} ~dst:screen ~dst_rect:vrect1 ();
blit_surface ~src:whitev ~src_rect:{vrect2 with r_x=0;r_w=1} ~dst:screen ~dst_rect:vrect2 ()
| Save ->
blit_surface ~dst:shadowh ~dst_rect:{hrect1 with r_y=0;r_h=1} ~src:screen ~src_rect:hrect1 ();
blit_surface ~dst:shadowh ~dst_rect:{hrect2 with r_y=1;r_h=1} ~src:screen ~src_rect:hrect2 ();
blit_surface ~dst:shadowv ~dst_rect:{vrect1 with r_x=0;r_w=1} ~src:screen ~src_rect:vrect1 ();
blit_surface ~dst:shadowv ~dst_rect:{vrect2 with r_x=1;r_w=1} ~src:screen ~src_rect:vrect2 ()
| Restore ->
blit_surface ~src:shadowh ~src_rect:{hrect1 with r_y=0;r_h=1} ~dst:screen ~dst_rect:hrect1 ();
blit_surface ~src:shadowh ~src_rect:{hrect2 with r_y=1;r_h=1} ~dst:screen ~dst_rect:hrect2 ();
blit_surface ~src:shadowv ~src_rect:{vrect1 with r_x=0;r_w=1} ~dst:screen ~dst_rect:vrect1 ();
blit_surface ~src:shadowv ~src_rect:{vrect2 with r_x=1;r_w=1} ~dst:screen ~dst_rect:vrect2 ()
| Update ->
List.iter (fun r -> Sdlvideo.update_rect ~rect:r screen) [hrect1;hrect2;vrect1;vrect2]
;;
(* draw *)
let redraw () =
Printf.eprintf "Computing...%!";
draw screen (compute());
Sdlvideo.update_rect screen;
Printf.eprintf "done.\n%!";;
(* event loop for zooming into the picture *)
let rezoom x y w =
let deltas = ((float !n)/.(float w)) in
ofx := (!ofx +. (float x)) *. deltas;
ofy := (!ofy +. (float y)) *. deltas;
scale := !scale *. deltas;
redraw();;
let reset () = scale:=1.; ofx:=0.; ofy:=0.;redraw();;
let refine () = res:=!res*2; redraw ();;
let unrefine () = res:=!res/2; redraw ();;
let zoom_in () = rezoom (!n/4) (!n/4) (!n/2);;
let zoom_out () = rezoom (-(!n/2)) (-(!n/2)) (!n*2);;
let dump () =
Printf.eprintf "Dumping image taken at ofx: %f ofy: %f scale: %f\n%!" !ofx !ofy !scale;
Sdlvideo.save_BMP screen (Printf.sprintf "mandels-ofx-%f-ofy-%f-scale-%f.bmp" !ofx !ofy !scale);;
(* encode state machine here *)
let rec init () =
match wait_event () with
| KEYDOWN {keysym=k} ->
(match k with
KEY_PLUS -> let _ = zoom_in() in init ()
| KEY_MINUS -> let _ = zoom_out() in init ()
| KEY_r -> let _ = refine () in init ()
| KEY_u -> let _ = unrefine () in init ()
| KEY_c -> let _ = reset() in init ()
| KEY_d -> let _ = dump() in init ()
| KEY_q -> Sdl.quit
| _ -> init ()
)
| MOUSEBUTTONDOWN {mbe_x=x;mbe_y=y} -> track_rect x y (x,y,0,0)
| _ -> init ()
and track_rect x y (ox,oy,ow,oh) =
match wait_event () with
| MOUSEBUTTONUP {mbe_x=x';mbe_y=y'} ->
let bx,by,w,h = (min x x'), (min y y'), (abs (x'-x)), (abs (y'-y)) in
(rezoom bx by (min w h); init())
| MOUSEMOTION {mme_x=x';mme_y=y'} ->
let bx,by,w,h = (min x x'), (min y y'), (abs (x'-x)), (abs (y'-y)) in
(* restore old image if necessary *)
if ow>0 & oh>0 then begin
border Restore ox oy ow oh;
border Update ox oy ow oh
end;
(* save image if necessary *)
if w>0 & h>0 then begin
border Save bx by w h;
(* draw the border *)
border Draw bx by w h;
border Update bx by w h;
end;
track_rect x y (bx,by,w,h)
| _ -> track_rect x y (ox,oy,ow,oh)
;;
let _ =
let getarg i = max 1 (int_of_string Sys.argv.(i)) in
try
ncores := getarg 1;Printf.eprintf "Setting nproc = %d \n%!" !ncores;
chunksize := getarg 2;Printf.eprintf "Setting chunksize = %d \n%!" !chunksize
with _ -> ()
;;
redraw();;
init()
