[MLton-commit] r6219

Vesa Karvonen vesak at mlton.org
Wed Nov 28 06:10:48 PST 2007


Added setGamma.
----------------------------------------------------------------------

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/sdl.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/sdl/unstable/detail/sdl.sml	2007-11-28 13:04:46 UTC (rev 6218)
+++ mltonlib/trunk/org/mlton/vesak/sdl/unstable/detail/sdl.sml	2007-11-28 14:10:47 UTC (rev 6219)
@@ -55,8 +55,8 @@
    type xy = {x : Int.t, y : Int.t}
    type wh = {w : Int.t, h : Int.t}
    type xywh = {x : Int.t, y : Int.t, w : Int.t, h : Int.t}
-   type rgb = {r : Word8.t, g : Word8.t, b : Word8.t}
-   type rgba = {r : Word8.t, g : Word8.t, b : Word8.t, a : Word8.t}
+   type 'a rgb = {r : 'a, g : 'a, b : 'a}
+   type 'a rgba = {r : 'a, g : 'a, b : 'a, a : 'a}
 
    structure Surface = struct
       type 'a t = (T_SDL_Surface.t, C.rw) C.obj C.ptr'
@@ -107,6 +107,9 @@
                                    {w = `S_SDL_Rect.f_w',
                                     h = `S_SDL_Rect.f_h'}::ms)
                             end)
+      val toFloat = Real32.fromLarge IEEEReal.TO_NEAREST
+      fun setGamma {r, g, b} =
+          checkInt (F_SDL_SetGamma.f' (toFloat r, toFloat g, toFloat b))
    end
 
    fun fillRect surface color =

Modified: mltonlib/trunk/org/mlton/vesak/sdl/unstable/public/sdl.sig
===================================================================
--- mltonlib/trunk/org/mlton/vesak/sdl/unstable/public/sdl.sig	2007-11-28 13:04:46 UTC (rev 6218)
+++ mltonlib/trunk/org/mlton/vesak/sdl/unstable/public/sdl.sig	2007-11-28 14:10:47 UTC (rev 6219)
@@ -48,8 +48,8 @@
    type xy = {x : Int.t, y : Int.t}
    type wh = {w : Int.t, h : Int.t}
    type xywh = {x : Int.t, y : Int.t, w : Int.t, h : Int.t}
-   type rgb = {r : Word8.t, g : Word8.t, b : Word8.t}
-   type rgba = {r : Word8.t, g : Word8.t, b : Word8.t, a : Word8.t}
+   type 'a rgb = {r : 'a, g : 'a, b : 'a}
+   type 'a rgba = {r : 'a, g : 'a, b : 'a, a : 'a}
 
    structure Surface : sig
       type 'a t
@@ -60,8 +60,8 @@
 
    structure Color : sig
       type t
-      val fromRGB : 'any Surface.t -> rgb -> t
-      val fromRGBA : 'any Surface.t -> rgba -> t
+      val fromRGB : 'any Surface.t -> Word8.t rgb -> t
+      val fromRGBA : 'any Surface.t -> Word8.t rgba -> t
    end
 
    structure Video : sig
@@ -69,6 +69,7 @@
       val getSurface : {video : yes} Surface.t Thunk.t
       val getDriverName : String.t Thunk.t
       val listModes : Prop.flags -> wh List.t Option.t
+      val setGamma : Real.t rgb Effect.t
    end
 
    val fillRect : 'any Surface.t -> Color.t -> xywh Option.t Effect.t




More information about the MLton-commit mailing list