[from now] 2012/09/20 00:11:02

diff --git a/test/OMakefile b/test/OMakefile
index bd195ff..50f10c8 100644
--- a/test/OMakefile
+++ b/test/OMakefile
@@ -30,8 +30,8 @@ open MyOCaml
 USE_OCAMLFIND = true
 #
 OCAMLPACKS[] =
-#    glMLite
-#    stdlib
+    threads
+    oUnit
 #
 if $(not $(OCAMLFIND_EXISTS))
    eprintln(This project requires ocamlfind, but is was not found.)
@@ -54,7 +54,7 @@ BYTE_ENABLED = $(not $(OCAMLOPT_EXISTS))
 #
 # Various options
 #
-OCAMLFLAGS    += -annot
+OCAMLFLAGS    += -annot -thread
 # OCAMLCFLAGS   +=
 # OCAMLOPTFLAGS +=
 OCAML_LINK_FLAGS += -cclib "$(shell sdl-config --libs)"
@@ -80,7 +80,7 @@ PROGRAM = test
 #
 OCAML_LIBS += ../src/sdlcaml
 # OCAML_CLIBS +=
-# OCAML_OTHER_LIBS += nums Glut GL bigarray vertArray VBO
+# OCAML_OTHER_LIBS +=
 # OCAML_LIB_FLAGS += -cclib -lsdl
 # OCAML_LIB_FLAGS += -verbose
 # OCAML_PACKAGE_NAME =
[from now] 2012/09/20 00:11:32

diff --git a/src/sdl_video.ml b/src/sdl_video.ml
index 0e574aa..8327e88 100644
--- a/src/sdl_video.ml
+++ b/src/sdl_video.ml
@@ -56,11 +56,17 @@ type pixelformat = {
 }

 (**
- * type of color that is synonym of {!int}.
- * this type is included some color for instance, Red, Green,
- * Blue, Alpha  or pixel color such as RGBA.
+ * type of color which is included each color elements and
+ * combined with of those.
+ * this type has appliable functions such a conversion
+ * colors, or split color to elements.
  *)
-type color = int
+type color = {
+  red:int;                              (* red attribute *)
+  blue:int;                             (* blue attribute *)
+  green:int;                            (* green attribute *)
+  alpha:int;                            (* transparently *)
+}

 (**
  * Binding of {i SDL_SetVideoMode}. if this function failed, raise
@@ -97,3 +103,40 @@ external sdl_free_surface: surface -> unit = "sdlcaml_free_surface"
  * @return valid pixelformat in a given surface
  *)
 external sdl_get_pixelformat: surface -> pixelformat = "sdlcaml_get_pixelformat"
+
+(** result of {!sdl_blit_surface} function. *)
+type blit_result =
+  BLIT_SUCCESS
+| BLIT_FAILURE
+| BLIT_LOST
+
+(**
+ * bliting clipped src surface with src rect to clippied dist surface
+ * by dist rect.
+ * When this function return BLIT_LOST, these should be reloaded with
+ * artwork or be redrew by some operation, and re-blitted.
+ *
+ * {!srect} and {!drect} are optional arguments. if these are not
+ * received some rectangle, there are used to {b NULL}.
+ *
+ * @param src source surface
+ * @param dist distination surface
+ * @param srect size of the copied rectangle
+ * @param drect position of the copied rectangle's upper left corner
+ * @return result of SDL_BlitSurface operation.
+ *)
+external sdl_blit_surface: src:surface -> dist:surface
+  -> ?srect:rect -> ?drect:rect -> blit_result = "sdlcaml_blit_surface"
+
+(**
+ * Fill of the given rectangle with some color.
+ * this function will fill the whole surface if you doesn't give {b
+ * drect}.
+ *
+ * @param dist distination surface
+ * @param fill filling color that should be a pixel of the format used
+ *             by the distination surface
+ * @param drect filling space of rectanble
+ *)
+external sdl_fill_color: dist:surface -> fill:color -> ?drect:rect ->
+  unit = "sdlcaml_fill_rect"
diff --git a/test/test_sdl_video.ml b/test/test_sdl_video.ml
new file mode 100644
index 0000000..8918c0e
--- /dev/null
+++ b/test/test_sdl_video.ml
@@ -0,0 +1,65 @@
+open Sdlcaml
+open OUnit
+
+let test_set_up _ =
+  begin
+    Sdl.sdl_init [`VIDEO];
+    sdl_set_video_mode ~width:640 ~height:480 ~depth:24
+      ~flags:[SDL_SWSURFACE];
+  end
+
+let test_tear_down surface =
+  begin
+    Sdl_video.sdl_free_surface surface;
+    Sdl.sdl_quit ();
+  end
+
+let test_sdl_video_init surface =
+  begin
+    Thread.delay 3.0;
+  end
+
+let test_sdl_get_pixel_format surface =
+  begin
+    let format = sdl_get_pixelformat surface in
+    assert_equal 24 format.bits_per_pixel;
+    assert_equal 3 format.bytes_per_pixel;
+    assert_equal 0xFF0000 format.rmask;
+    assert_equal 0xFF00 format.gmask;
+    assert_equal 0xFF format.bmask;
+  end
+
+let test_sdl_fill_color surface =
+  begin
+    let col = {red = 255; green = 128; blue = 0; alpha = 255} in
+    Sdl_video.sdl_fill_color ~dist:surface ~fill:col;
+    Thread.delay 5.0;
+  end
+
+let test_sdl_blit_surface surface =
+  begin
+    let newsurface = Sdl_video.sdl_create_surface
+      ~flags:[SDL_SWSURFACE;SDL_SRCALPHA] ~width:300 ~height:200
+    and col = {red = 255; green = 128; blue = 0; alpha = 255} in
+    Sdl_video.sdl_fill_color ~dist:newsurface ~fill:col;
+    Sdl_video.sdl_blit_surface ~src:newsurface ~dist:surface;
+    Thread.delay 3.0;
+    Sdl_video.sdl_free_surface newsurface;
+  end
+
+let test_sdl_get
+
+let suite = "SDL video tests" >:::
+  [ "video initialize" >:: (bracket test_set_up test_sdl_video_init
+                               test_tear_down);
+    "get current pixel format" >::
+      (bracket test_set_up test_sdl_get_pixel_format test_tear_down);
+    "fill color" >::
+      (bracket test_set_up test_sdl_fill_color test_tear_down);
+    "blit surface" >::
+      (bracket test_set_up test_sdl_blit_surface test_tear_down);
+
+  ]
+
+let _ =
+  run_test_tt_main suite
[from now] 2012/09/21 07:56:51

diff --git a/test/test_sdl_video.ml b/test/test_sdl_video.ml
index 8918c0e..b6bd791 100644
--- a/test/test_sdl_video.ml
+++ b/test/test_sdl_video.ml
@@ -4,8 +4,8 @@ open OUnit
 let test_set_up _ =
   begin
     Sdl.sdl_init [`VIDEO];
-    sdl_set_video_mode ~width:640 ~height:480 ~depth:24
-      ~flags:[SDL_SWSURFACE];
+    Sdl_video.sdl_set_video_mode ~width:640 ~height:480 ~depth:24
+      ~flags:[Sdl_video.SDL_SWSURFACE];
   end

 let test_tear_down surface =
@@ -21,7 +21,8 @@ let test_sdl_video_init surface =

 let test_sdl_get_pixel_format surface =
   begin
-    let format = sdl_get_pixelformat surface in
+    let format = Sdl_video.sdl_get_pixelformat surface in
+    let open Sdl_video in
     assert_equal 24 format.bits_per_pixel;
     assert_equal 3 format.bytes_per_pixel;
     assert_equal 0xFF0000 format.rmask;
@@ -31,24 +32,24 @@ let test_sdl_get_pixel_format surface =

 let test_sdl_fill_color surface =
   begin
+    let open Sdl_video in
     let col = {red = 255; green = 128; blue = 0; alpha = 255} in
-    Sdl_video.sdl_fill_color ~dist:surface ~fill:col;
+    Sdl_video.sdl_fill_color ~dist:surface ~fill:col ();
     Thread.delay 5.0;
   end

 let test_sdl_blit_surface surface =
   begin
+    let open Sdl_video in
     let newsurface = Sdl_video.sdl_create_surface
       ~flags:[SDL_SWSURFACE;SDL_SRCALPHA] ~width:300 ~height:200
     and col = {red = 255; green = 128; blue = 0; alpha = 255} in
-    Sdl_video.sdl_fill_color ~dist:newsurface ~fill:col;
-    Sdl_video.sdl_blit_surface ~src:newsurface ~dist:surface;
+    Sdl_video.sdl_fill_color ~dist:newsurface ~fill:col ();
+    assert_equal BLIT_SUCCESS (Sdl_video.sdl_blit_surface ~src:newsurface ~dist:surface ());
     Thread.delay 3.0;
     Sdl_video.sdl_free_surface newsurface;
   end

-let test_sdl_get
-
 let suite = "SDL video tests" >:::
   [ "video initialize" >:: (bracket test_set_up test_sdl_video_init
                                test_tear_down);