Некоторые (VladD2) просили написать Alpha Blend (
http://www.rsdn.ru/Forum/Message.aspx?mid=986326&only=1) на функциональном языке. Я переписал его на OCaml в соответствии с С++ вариантом. Правда, на OCaml не получается 3 различных реализаций, как на С++ или С#. Я сделал только 2. В одной индекс массива вычисляется постепенно (соответствует варианту 1 на С++), а во второй для каждого элемента массива отдельно (вариант 3). Самый быстрый вариант работает где-то раза в 2 медленнее чем аналог на С++, что совсем неплохо.
Программа (исключая random) полностью функциональна без каких-либо императивных наворотов. Единственное, чтобы не писать в вызове каждой функции лишний параметр, я пользуюсь массивом неявно, но это допустимо, поскольку на массив существует только одна ссылка.
Такие алгоритмы, вообще говоря, следует реализовывать на С, поэтому претензии по поводу уродливости кода я не принимаю.
Скомпилировать программу можно с помощью команды (нужен cygwin или vc++):
ocamlopt -inline 5 -o alphaml bigarray.cmxa unix.cmxa alphaml.ml
Оптимизационные опции на ocaml никак не действуют, поэтому я их не указываю.
open Int32;;
open Bigarray;;
let time = ref 0.0;;
let timer_start () =
Printf.printf "Start...\n";
time := Unix.gettimeofday ();;
let timer_stop () =
let elapsed = ((Unix.gettimeofday ()) -. (!time)) in
let rate = 1000.0 /. elapsed in
Printf.printf "Stop. Speed is %f frames per seconds (%f)\n" rate elapsed;;
let rseed = ref (of_int 1234);;
let mul1 = (of_int 214013);;
let mul2 = (of_int 2531011);;
let mask = (of_int 0x7FFFFFFF);;
let random () =
let nrs = add (mul (!rseed) mul1) mul2 in
rseed := nrs;
abs (shift_right nrs 16);;
let rmask = (of_int 0xFF);;
let gmask = (of_int 0xFF00);;
let bmask = (of_int 0xFF0000);;
let amask = (shift_left bmask 8);;
let i255 = of_int 255;;
let test_alpha_blend w h n =
let arr = Array1.create int32 c_layout (w*h) in
let w32 = of_int w
and h32 = of_int h in
let alpha_blend_rect x y w2 h2 =
let r = rem (random ()) i255
and g = rem (random ()) i255
and b = rem (random ()) i255
and a = rem (random ()) i255 in
let rec loop n =
if n=h2 then () else
let y = add y n in
let rec alpha_blend_span1 n =
if n = w2 then () else
let ind = to_int (add (add (mul y w32) x) n) in
let rgba = arr.{ind} in
let rn = add (shift_right (mul (sub r (logand rgba rmask)) a) 8) rgba
and gn = add (mul (sub g (shift_right (logand rgba gmask) 8)) a) (logand rgba gmask)
and bn = add (shift_left (mul (sub b (shift_right (logand rgba bmask) 16)) a) 8)
(logand rgba bmask)
and an = shift_left (sub (add (shift_right_logical rgba 24) a)
(shift_right (mul a (shift_right_logical rgba 24)) 8)) 24 in
arr.{ind} <- (logor an (logor (logor (logand rn rmask)
(logand gn gmask)) (logand bn bmask)));
alpha_blend_span1 (succ n) in
let rec alpha_blend_span2 ind n =
if n = w2 then () else
let rgba = arr.{ind} in
let rn = add (shift_right (mul (sub r (logand rgba rmask)) a) 8) rgba
and gn = add (mul (sub g (shift_right (logand rgba gmask) 8)) a) (logand rgba gmask)
and bn = add (shift_left (mul (sub b (shift_right (logand rgba bmask) 16)) a) 8)
(logand rgba bmask)
and an = shift_left (sub (add (shift_right_logical rgba 24) a)
(shift_right (mul a (shift_right_logical rgba 24)) 8)) 24 in
arr.{ind} <- (logor an (logor (logor (logand rn rmask)
(logand gn gmask)) (logand bn bmask)));
alpha_blend_span2 (ind+1) (succ n) in
(* alpha_blend_span1 zero; *)
alpha_blend_span2 (to_int (add (mul y w32) x)) zero;
loop (succ n) in
loop zero in
let rec loop n =
if n=0 then () else
let x1 = rem (random ()) w32
and y1 = rem (random ()) h32
and x2 = rem (random ()) w32
and y2 = rem (random ()) h32 in
let mx = if (x1 > x2) then x2 else x1
and my = if (y1 > y2) then y2 else y1 in
let _ = alpha_blend_rect mx my (succ (abs (sub x1 x2))) (succ (abs (sub y1 y2))) in
loop (n-1) in
loop n;;
let main () =
let w = 1000
and h = 1000
and n = 1000 in
timer_start ();
test_alpha_blend w h n;
timer_stop ();;
main ();;