Alpha blend на OCaml
От: Quintanar Россия  
Дата: 30.03.05 14:59
Оценка: 85 (10)
Некоторые (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 ();;
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.