In [1]:

    

#use "../tools/image.ml"


    

    




module type ImageOps =
  sig
    type pixel
    type image
    val create : width:int -> height:int -> image
    val init : width:int -> height:int -> f:(int -> int -> pixel) -> image
    val width : image -> int
    val height : image -> int
    val pixel : r:int -> g:int -> b:int -> pixel
    val pixela : r:int -> g:int -> b:int -> a:int -> pixel
    val get : image -> x:int -> y:int -> pixel
    val set : image -> x:int -> y:int -> pixel -> unit
    val r : pixel -> int
    val g : pixel -> int
    val b : pixel -> int
    val a : pixel -> int
  end
module type WritePng =
  sig type image val write : out_channel -> image -> unit end
module WritePng :
  functor (P : ImageOps) ->
    sig type image = P.image val write : out_channel -> image -> unit end
module RgbImage :
  sig
    type pixel = { r : char; g : char; b : char; a : char; }
    type image = pixel array array
    val pixel : r:int -> g:int -> b:int -> pixel
    val pixela : r:int -> g:int -> b:int -> a:int -> pixel
    val create : width:int -> height:int -> pixel array array
    val init :
      width:int -> height:int -> f:(int -> int -> 'a) -> 'a array array
    val height : 'a array -> int
    val width : 'a array array -> int
    val get : 'a array array -> x:int -> y:int -> 'a
    val set : 'a array array -> x:int -> y:int -> 'a -> unit
    val r : pixel -> int
    val g : pixel -> int
    val b : pixel -> int
    val a : pixel -> int
  end
module RgbToPng :
  sig
    type image = RgbImage.image
    val write : out_channel -> image -> unit
  end

In [2]:

    

let image_printer fmt i = 
    let () = RgbToPng.write Iocaml.mime i in
    let () = Iocaml.send_mime ~base64:true "image/png" in
    Format.fprintf fmt "<png image>"
;;
#install_printer image_printer


    

    




val image_printer : Format.formatter -> RgbToPng.image -> unit = <fun>

In [3]:

    

open RgbImage


    

In [4]:

    

init 100 100 (fun x y -> pixel x y 0)


    

    













    




- : RgbImage.pixel array array = <png image>

In [5]:

    

init 100 100 (fun x y -> 
    let x,y = float_of_int x -. 50., float_of_int y -. 50. in
    if sqrt (x *. x +. y *. y) <= 20. then pixel 255 255 255
    else pixel 0 0 0)


    

    













    




- : RgbImage.pixel array array = <png image>

In [6]:

    

let draw_line ~img ~pixel ~p0:(x0,y0) ~p1:(x1,y1) =
 
  let steep = abs(y1 - y0) > abs(x1 - x0) in
 
  let plot =
    if steep
    then (fun x y -> set img pixel ~x:y ~y:x)
    else (fun x y -> set img pixel ~x:x ~y:y)
  in
 
  let x0, y0, x1, y1 =
    if steep
    then y0, x0, y1, x1
    else x0, y0, x1, y1
  in
  let x0, x1, y0, y1 =
    if x0 > x1
    then x1, x0, y1, y0
    else x0, x1, y0, y1
  in
 
  let delta_x = x1 - x0
  and delta_y = abs(y1 - y0) in
  let error = -delta_x / 2
  and y_step =
    if y0 < y1 then 1 else -1
  in
  let rec loop x y error =
    plot x y;
    if x <= x1 then
      let error = error + delta_y in
      let y, error =
        if error > 0
        then (y + y_step), (error - delta_x)
        else y, error
      in
      loop (succ x) y error
  in
  loop x0 y0 error


    

    




val draw_line :
  img:'a array array -> pixel:'a -> p0:int * int -> p1:int * int -> unit =
  <fun>

In [7]:

    

let img = create 100 100


    

    













    




val img : RgbImage.pixel array array = <png image>

In [8]:

    

draw_line ~img ~pixel:(pixel 255 0 0) ~p0:(10,10) ~p1:(90,90)


    

    




- : unit = ()

In [9]:

    

img


    

    













    




- : RgbImage.pixel array array = <png image>

In [10]:

    

draw_line ~img ~pixel:(pixel 0 255 0) ~p0:(10,90) ~p1:(90,10);
draw_line ~img ~pixel:(pixel 0 0 255) ~p0:(50,10) ~p1:(50,90);
draw_line ~img ~pixel:(pixel 255 0 255) ~p0:(10,50) ~p1:(90,50)


    

    




- : unit = ()

In [11]:

    

img


    

    













    




- : RgbImage.pixel array array = <png image>

In [12]:

    

let mandelbrot ?(quality=60) ?(ax=0.0) ?(ay=0.0) ?(zoom=4.0) width height =
    let image = create width height in
    let iteration_count x0 y0 =
        let rec iter' x y n =
            if n = quality then quality else
            if x *. x +. y *. y > 4.0 
            then n
            else iter' (x *. x -. y *. y +. x0) (2.0 *. x *. y +. y0) (succ n)
        in
        iter' 0.0 0.0 0
    in
    let zoom_c = zoom /. float width in
    let offs_x = ax -. zoom /. 2.0 in
    let offs_y = ay -. zoom /. 2.0 in
    for j = 0 to width - 1 do
        for k = 0 to height - 1 do
            let ca = zoom_c *. float j +. offs_x in
            let cb = zoom_c *. float k +. offs_y in
            let c = iteration_count ca cb in
            let f i = int_of_float (255. *. (0.5 +. 0.5 *. cos(float i *. 0.1))) in 
            set image ~x:j ~y:k (pixel (f c) (f (c+(quality/4))) (f (c+(quality/2)))) 
        done;
    done;
    image


    

    




val mandelbrot :
  ?quality:int ->
  ?ax:float ->
  ?ay:float -> ?zoom:float -> int -> int -> RgbImage.pixel array array =
  <fun>

In [13]:

    

mandelbrot ~quality:60 200 200


    

    













    




- : RgbImage.pixel array array = <png image>

In [14]: