[MLton-commit] r6227

[Vesa Karvonen]

Added support for surface clipping rectangle.
----------------------------------------------------------------------

U   mltonlib/trunk/org/mlton/vesak/sdl/unstable/detail/lib/util.c
U   mltonlib/trunk/org/mlton/vesak/sdl/unstable/detail/lib/util.h
U   mltonlib/trunk/org/mlton/vesak/sdl/unstable/detail/sdl.sml
U   mltonlib/trunk/org/mlton/vesak/sdl/unstable/public/sdl.sig

----------------------------------------------------------------------

Modified: mltonlib/trunk/org/mlton/vesak/sdl/unstable/detail/lib/util.c
===================================================================
--- mltonlib/trunk/org/mlton/vesak/sdl/unstable/detail/lib/util.c	2007-11-29 14:02:58 UTC (rev 6226)
+++ mltonlib/trunk/org/mlton/vesak/sdl/unstable/detail/lib/util.c	2007-11-29 14:18:01 UTC (rev 6227)
@@ -19,3 +19,9 @@
   SDL_Rect sr = {sx, sy, sw, sh}, dr = {dx, dy, dw, dh};
   return SDL_BlitSurface(s, &sr, d, &dr);
 }
+
+void
+SML_SDL_SetClipRect(SDL_Surface *d, int x, int y, unsigned w, unsigned h) {
+  SDL_Rect dr = {x, y, w, h};
+  SDL_SetClipRect(d, &dr);
+}

Modified: mltonlib/trunk/org/mlton/vesak/sdl/unstable/detail/lib/util.h
===================================================================
--- mltonlib/trunk/org/mlton/vesak/sdl/unstable/detail/lib/util.h	2007-11-29 14:02:58 UTC (rev 6226)
+++ mltonlib/trunk/org/mlton/vesak/sdl/unstable/detail/lib/util.h	2007-11-29 14:18:01 UTC (rev 6227)
@@ -17,4 +17,7 @@
 SML_SDL_BlitRect(SDL_Surface *s, int sx, int sy, unsigned sw, unsigned sh,
                  SDL_Surface *d, int dx, int dy, unsigned dw, unsigned dh);
 
+void
+SML_SDL_SetClipRect(SDL_Surface *d, int x, int y, unsigned w, unsigned h);
+
 #endif

Modified: mltonlib/trunk/org/mlton/vesak/sdl/unstable/detail/sdl.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/sdl/unstable/detail/sdl.sml	2007-11-29 14:02:58 UTC (rev 6226)
+++ mltonlib/trunk/org/mlton/vesak/sdl/unstable/detail/sdl.sml	2007-11-29 14:18:01 UTC (rev 6227)
@@ -147,6 +147,17 @@
                    ; checkPtr (F_SDL_ConvertSurface.f'
                                   (surface, C.Ptr.|&! pf, flags))
                   end)
+      fun getClipRect surface =
+          one (withNew S_SDL_Rect.size)
+              (fn r =>
+                  (F_SDL_GetClipRect.f' (surface, C.Ptr.|&! r)
+                 ; {pos = {x = Int16.toInt (C.Get.sshort' (S_SDL_Rect.f_x' r)),
+                           y = Int16.toInt (C.Get.sshort' (S_SDL_Rect.f_y' r))},
+                    dim = {w = Word16.toInt (C.Get.ushort' (S_SDL_Rect.f_w' r)),
+                           h = Word16.toInt (C.Get.ushort' (S_SDL_Rect.f_h' r))}}))
+      fun setClipRect surface {pos = {x, y}, dim = {w, h}} =
+          F_SML_SDL_SetClipRect.f'
+             (surface, x, y, Word.fromInt w, Word.fromInt h)
    end
 
    structure Video = struct

Modified: mltonlib/trunk/org/mlton/vesak/sdl/unstable/public/sdl.sig
===================================================================
--- mltonlib/trunk/org/mlton/vesak/sdl/unstable/public/sdl.sig	2007-11-29 14:02:58 UTC (rev 6226)
+++ mltonlib/trunk/org/mlton/vesak/sdl/unstable/public/sdl.sig	2007-11-29 14:18:01 UTC (rev 6227)
@@ -72,6 +72,8 @@
       val blit : 'src t -> 'dst t Effect.t
       val blitRect : 'src t -> Int.t Rect.t -> 'dst t -> Int.t Rect.t Effect.t
       val convert : Pixel.Format.t -> Prop.flags -> 'any t -> {video : no} t
+      val getClipRect : 'any t -> Int.t Rect.t
+      val setClipRect : 'any t -> Int.t Rect.t Effect.t
    end
 
    structure Video : sig