[MLton-commit] r6230

Vesa Karvonen vesak at mlton.org
Fri Nov 30 04:38:09 PST 2007


Added a few new things and removed a few deprecated / obsolete features.
----------------------------------------------------------------------

U   mltonlib/trunk/org/mlton/vesak/sdl/unstable/detail/sdl.sml
U   mltonlib/trunk/org/mlton/vesak/sdl/unstable/example/bounce/bounce.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-29 20:08:19 UTC (rev 6229)
+++ mltonlib/trunk/org/mlton/vesak/sdl/unstable/detail/sdl.sml	2007-11-30 12:38:08 UTC (rev 6230)
@@ -43,15 +43,13 @@
    structure Prop = struct
       open Word32Flags
       val ` = Word32.fromLargeInt
-      val SWSURFACE  = `SDL_SWSURFACE
-      val HWSURFACE  = `SDL_HWSURFACE
+      val SW         = `SDL_SWSURFACE
+      val HW         = `SDL_HWSURFACE
       val ASYNCBLIT  = `SDL_ASYNCBLIT
       val ANYFORMAT  = `SDL_ANYFORMAT
-      val HWPALETTE  = `SDL_HWPALETTE
       val DOUBLEBUF  = `SDL_DOUBLEBUF
       val FULLSCREEN = `SDL_FULLSCREEN
       val OPENGL     = `SDL_OPENGL
-      val OPENGLBLIT = `SDL_OPENGLBLIT
       val RESIZABLE  = `SDL_RESIZABLE
       val NOFRAME    = `SDL_NOFRAME
    end
@@ -60,7 +58,13 @@
    structure Dim = struct type 'a t = {w : 'a, h : 'a} end
    structure Rect = struct type 'a t = {pos : 'a Pos.t, dim : 'a Dim.t} end
    structure RGB = struct type 'a t = {r : 'a, g : 'a, b : 'a} end
-   structure RGBA = struct type 'a t = {r : 'a, g : 'a, b : 'a, a : 'a} end
+   structure RGBA = struct
+      type 'a t = {r : 'a, g : 'a, b : 'a, a : 'a}
+      fun unOp f {r, g, b, a} = {r = f r, g = f g, b = f b, a = f a}
+      fun binOp f (l : 'a t, r : 'b t) =
+          {r = f (#r l, #r r), g = f (#g l, #g r),
+           b = f (#b l, #b r), a = f (#a l, #a r)}
+   end
 
    structure Pixel = struct
       type t = Word32.t
@@ -73,41 +77,91 @@
                    mask : t RGBA.t,
                    shift : Word8.t RGBA.t,
                    loss : Word8.t RGBA.t}
+
+         fun bits (t : t) = Word8.toWord (#bits t)
+         fun bitsRGBA (t : t) =
+             RGBA.unOp (fn x => 0w8 - Word8.toWord x) (#loss t)
+         val bitsRGB = (fn {r, g, b, ...} => {r = r, g = g, b = b}) o bitsRGBA
+
+         fun fromRGBA (rgba as {r, g, b, a}) : t = let
+            val bits = r+g+b+a
+            val shift = {b = 0w0, g = b, r = g+b,
+                         a = if 0w0 = a then 0w0 else r+g+b}
+            val loss = RGBA.unOp (0w8 <\ op -) rgba
+         in
+            {alpha = 0w255, key = 0w0, bits = bits,
+             bytes = (bits + 0w7) div 0w8,
+             mask = RGBA.binOp (fn (s, l) => let
+                                      open Word32
+                                   in
+                                      (0w255 >> Word8.toWord l) << Word8.toWord s
+                                   end)
+                               (shift, loss),
+             shift = shift, loss = loss}
+         end
+
+         val r5g6b5   = fromRGBA {r=0w5, g=0w6, b=0w5, a=0w0}
+         val r8g8b8   = fromRGBA {r=0w8, g=0w8, b=0w8, a=0w0}
+         val r8g8b8_8 = {alpha = #alpha r8g8b8, key = #key r8g8b8, bits = 0w32,
+                         bytes = 0w4, mask = #mask r8g8b8, loss = #loss r8g8b8,
+                         shift = #shift r8g8b8} : t
+         val r8g8b8a8 = fromRGBA {r=0w8, g=0w8, b=0w8, a=0w8}
+
+         fun fromSDL pf = let
+            fun w f = C.Get.uint' (f pf)
+            fun b f = C.Get.uchar' (f pf)
+            open S_SDL_PixelFormat
+            val mask = {r=w f_Rmask', g=w f_Gmask', b=w f_Bmask', a=w f_Amask'}
+         in
+            {alpha = b f_alpha', key = w f_colorkey', bits = b f_BitsPerPixel',
+             bytes = b f_BytesPerPixel', mask = mask,
+             shift = {r=b f_Rshift', g=b f_Gshift', b=b f_Bshift', a=b f_Ashift'},
+             loss = {r=b f_Rloss', g=b f_Gloss', b=b f_Bloss',
+                     a=if 0w0 = #a mask then 0w8 else b f_Aloss'}}
+         end
+
+         fun withSDL ({alpha, key, bits, bytes, mask, shift, loss} : t) =
+             With.Monad.map
+                (fn pf => let
+                       fun w f v = C.Set.uint' (f pf, v)
+                       fun b f v = C.Set.uchar' (f pf, v)
+                       open S_SDL_PixelFormat
+                    in
+                       C.Set.ptr' (f_palette' pf, C.Ptr.null')
+                     ; b f_alpha' alpha
+                     ; w f_colorkey' key
+                     ; b f_BitsPerPixel' bits
+                     ; b f_BytesPerPixel' bytes
+                     ; b f_Rloss' (#r loss) ; b f_Gloss' (#g loss)
+                     ; b f_Bloss' (#b loss) ; b f_Aloss' (#a loss)
+                     ; w f_Rmask' (#r mask) ; w f_Gmask' (#g mask)
+                     ; w f_Bmask' (#b mask) ; w f_Amask' (#a mask)
+                     ; b f_Rshift' (#r shift) ; b f_Gshift' (#g shift)
+                     ; b f_Bshift' (#b shift) ; b f_Ashift' (#a shift)
+                     ; pf
+                    end)
+                (withNew S_SDL_PixelFormat.size)
       end
 
       fun fromRGBA ({shift, loss, ...} : Format.t) {r, g, b, a} = let
          open Word32
          fun pack (v, s, l) =
-             (Word32.fromWord8 v >> Word.fromWord8 l) << Word.fromWord8 s
+             (Word32.fromWord8 v >> Word8.toWord l) << Word8.toWord s
       in
-         pack (r, #r shift, #r loss) orb
-         pack (g, #g shift, #g loss) orb
-         pack (b, #b shift, #b loss) orb
-         pack (a, #a shift, #a loss)
+         pack (r, #r shift, #r loss) orb pack (g, #g shift, #g loss) orb
+         pack (b, #b shift, #b loss) orb pack (a, #a shift, #a loss)
       end
-      fun fromRGB format {r, g, b} =
-          fromRGBA format {r=r, g=g, b=b, a=0w255}
+      fun fromRGB format {r, g, b} = fromRGBA format {r=r, g=g, b=b, a=0w255}
    end
 
    structure Surface = struct
       type 'a t = (T_SDL_Surface.t, C.rw) C.obj C.ptr'
-      fun pixelFormat surface = let
-         val pf = C.Ptr.|*! (C.Get.ptr' (S_SDL_Surface.f_format' (C.Ptr.|*! surface)))
-         fun w f = C.Get.uint' (f pf)
-         fun b f = C.Get.uchar' (f pf)
-         open S_SDL_PixelFormat
-      in
-         {alpha = b f_alpha',
-          key   = w f_colorkey',
-          bits  = b f_BitsPerPixel',
-          bytes = b f_BytesPerPixel',
-          mask  = {r=w f_Rmask',  g=w f_Gmask',  b=w f_Bmask',  a=w f_Amask'},
-          shift = {r=b f_Rshift', g=b f_Gshift', b=b f_Bshift', a=b f_Ashift'},
-          loss  = {r=b f_Rloss',  g=b f_Gloss',  b=b f_Bloss',  a=b f_Aloss'}}
-      end
-      fun props s = C.Get.uint' (S_SDL_Surface.f_flags' (C.Ptr.|*! s))
-      fun dim s = {w = C.Get.sint' (S_SDL_Surface.f_w' (C.Ptr.|*! s)),
-                   h = C.Get.sint' (S_SDL_Surface.f_h' (C.Ptr.|*! s))}
+      fun getPixelFormat surface =
+          Pixel.Format.fromSDL o C.Ptr.|*! o C.Get.ptr' o
+          S_SDL_Surface.f_format' |< C.Ptr.|*! surface
+      fun getProps s = C.Get.uint' (S_SDL_Surface.f_flags' (C.Ptr.|*! s))
+      fun getDim s = {w = C.Get.sint' (S_SDL_Surface.f_w' (C.Ptr.|*! s)),
+                      h = C.Get.sint' (S_SDL_Surface.f_h' (C.Ptr.|*! s))}
       val free = F_SDL_FreeSurface.f'
       val flip = checkInt o F_SDL_Flip.f'
       fun update surface = F_SDL_UpdateRect.f' (surface, 0, 0, 0w0, 0w0)
@@ -125,28 +179,14 @@
           checkInt (F_SML_SDL_BlitRect.f'
                        (src, sx, sy, Word.fromInt sw, Word.fromInt sh,
                         dst, dx, dy, Word.fromInt dw, Word.fromInt dh))
-      fun convert ({alpha, key, bits, bytes, mask, shift, loss} : Pixel.Format.t)
-                  flags surface =
-          one (withNew S_SDL_PixelFormat.size)
-              (fn pf => let
-                     fun w f v = C.Set.uint' (f pf, v)
-                     fun b f v = C.Set.uchar' (f pf, v)
-                     open S_SDL_PixelFormat
-                  in
-                     C.Set.ptr' (f_palette' pf, C.Ptr.null')
-                   ; b f_alpha' alpha
-                   ; w f_colorkey' key
-                   ; b f_BitsPerPixel' bits
-                   ; b f_BytesPerPixel' bytes
-                   ; b f_Rloss' (#r loss) ; b f_Gloss' (#g loss)
-                   ; b f_Bloss' (#b loss) ; b f_Aloss' (#a loss)
-                   ; w f_Rmask' (#r mask) ; w f_Gmask' (#g mask)
-                   ; w f_Bmask' (#b mask) ; w f_Amask' (#a mask)
-                   ; b f_Rshift' (#r shift) ; b f_Gshift' (#g shift)
-                   ; b f_Bshift' (#b shift) ; b f_Ashift' (#a shift)
-                   ; checkPtr (F_SDL_ConvertSurface.f'
-                                  (surface, C.Ptr.|&! pf, flags))
-                  end)
+      fun convert format flags surface =
+          one (Pixel.Format.withSDL format)
+              (fn pf => checkPtr (F_SDL_ConvertSurface.f'
+                                     (surface, C.Ptr.|&! pf, flags)))
+      fun convertToVideo {alpha} =
+          checkPtr o (if alpha
+                      then F_SDL_DisplayFormatAlpha.f'
+                      else F_SDL_DisplayFormat.f')
       fun getClipRect surface =
           one (withNew S_SDL_Rect.size)
               (fn r =>
@@ -161,8 +201,9 @@
    end
 
    structure Video = struct
-      fun setMode props {bpp} {w, h} =
-          checkPtr (F_SDL_SetVideoMode.f' (w, h, bpp, props))
+      fun setMode fmt props {w, h} =
+          checkPtr (F_SDL_SetVideoMode.f'
+                       (w, h, Word.toIntX (Pixel.Format.bits fmt), props))
       val getSurface = checkPtr o F_SDL_GetVideoSurface.f'
       val maxDriverNameSz = 256 (* XXX is this large enough? *)
       fun getDriverName () =
@@ -172,23 +213,34 @@
                                       (buf, maxDriverNameSz))
                  then fail "Cannot get driver name.  Is SDL video initialized?"
                  else ZString.toML' buf)
-      fun listModes props =
-          case F_SDL_ListModes.f' (C.Ptr.null', props)
-           of modes =>
-              if C.Ptr.isNull' modes then SOME []
-              else if minus1ptr = C.Ptr.inject' modes then NONE
-              else recur (modes, []) (fn lp =>
-                      fn (modes, ms) =>
-                         if C.Ptr.isNull' (C.Get.ptr' (C.Ptr.|*! modes))
-                         then SOME ms
-                         else let
-                               val r = C.Ptr.|*! (C.Get.ptr' (C.Ptr.|*! modes))
-                               fun `f = Word16.toInt (C.Get.ushort' (f r))
-                            in
-                               lp (C.Ptr.|+! C.S.ptr (modes, 1),
-                                   {w = `S_SDL_Rect.f_w',
-                                    h = `S_SDL_Rect.f_h'}::ms)
-                            end)
+      fun getPixelFormat () = Pixel.Format.fromSDL o C.Ptr.|*! o C.Get.ptr' o
+                              S_SDL_VideoInfo.f_vfmt' o C.Ptr.|*! |<
+                              checkPtr (F_SDL_GetVideoInfo.f' ())
+      fun getDim () = let
+         val vi = C.Ptr.|*! (F_SDL_GetVideoInfo.f' ())
+      in
+          {w = C.Get.sint' (S_SDL_VideoInfo.f_current_w' vi),
+           h = C.Get.sint' (S_SDL_VideoInfo.f_current_h' vi)}
+      end
+      fun listModes format props =
+          one (Pixel.Format.withSDL format)
+              (fn pf =>
+                  case F_SDL_ListModes.f' (C.Ptr.|&! pf, props)
+                   of modes =>
+                      if C.Ptr.isNull' modes then SOME []
+                      else if minus1ptr = C.Ptr.inject' modes then NONE
+                      else recur (modes, []) (fn lp =>
+                       fn (modes, ms) =>
+                          if C.Ptr.isNull' (C.Get.ptr' (C.Ptr.|*! modes))
+                          then SOME ms
+                          else let
+                                val r = C.Ptr.|*! (C.Get.ptr' (C.Ptr.|*! modes))
+                                fun `f = Word16.toInt (C.Get.ushort' (f r))
+                             in
+                                lp (C.Ptr.|+! C.S.ptr (modes, 1),
+                                    {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))
@@ -251,6 +303,8 @@
          fun getPos () = getMouse F_SDL_GetMouseState.f'
          fun getDelta () = getMouse F_SDL_GetRelativeMouseState.f'
       end
+      fun setPos {x, y} =
+          F_SDL_WarpMouse.f' (Word16.fromInt x, Word16.fromInt y)
       fun getButtons () = F_SDL_GetMouseState.f' (C.Ptr.null', C.Ptr.null')
       fun showCursor b =
           ignore (F_SDL_ShowCursor.f' (if b

Modified: mltonlib/trunk/org/mlton/vesak/sdl/unstable/example/bounce/bounce.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/sdl/unstable/example/bounce/bounce.sml	2007-11-29 20:08:19 UTC (rev 6229)
+++ mltonlib/trunk/org/mlton/vesak/sdl/unstable/example/bounce/bounce.sml	2007-11-30 12:38:08 UTC (rev 6230)
@@ -10,7 +10,7 @@
    val w = ref 640
    val h = ref 480
    val fs = ref false
-   val bpp = ref 16
+   val bpp = ref NONE
    val size = ref 4
    val num = ref 100
    val fps = ref 50
@@ -28,17 +28,22 @@
 fun demo () = let
    val display =
        SDL.Video.setMode
+          (case !Opt.bpp
+            of NONE => SDL.Video.getPixelFormat ()
+             | SOME 16 => SDL.Pixel.Format.r5g6b5
+             | SOME 24 => SDL.Pixel.Format.r8g8b8
+             | SOME 32 => SDL.Pixel.Format.r8g8b8a8
+             | _ => fail "Unsupported pixel format")
           let open SDL.Prop in
              flags ([DOUBLEBUF] @
-                    (if !Opt.fs then [HWSURFACE, FULLSCREEN] else [])) end
-          {bpp = !Opt.bpp}
+                    (if !Opt.fs then [HW, FULLSCREEN] else [])) end
           {w = !Opt.w, h = !Opt.h}
 
-   val format = SDL.Surface.pixelFormat display
-   val props = SDL.Surface.props display
+   val format = SDL.Surface.getPixelFormat display
 
-   val chest = SDL.Surface.convert format props (SDL.Image.loadBMP "chest.bmp")
-   val chestDim as {w = chestW, h = chestH} = SDL.Surface.dim chest
+   val chest =
+       SDL.Surface.convertToVideo {alpha=false} (SDL.Image.loadBMP "chest.bmp")
+   val chestDim as {w = chestW, h = chestH} = SDL.Surface.getDim chest
 
    val green = SDL.Pixel.fromRGB format {r=0w000, g=0w128, b=0w000}
    val red   = SDL.Pixel.fromRGB format {r=0w128, g=0w000, b=0w000}
@@ -132,6 +137,7 @@
          | _ => (render () ; animate () ; sleep () ; lp ())
 in
    SDL.Mouse.showCursor false
+ ; SDL.Mouse.setPos {x = 0, y = 0}
  ; lp ()
 end
 
@@ -139,7 +145,8 @@
     (printlns ["Driver name: ", SDL.Video.getDriverName ()]
    ; print "Available full screen modes: "
    ; case SDL.Video.listModes
-             let open SDL.Prop in flags [DOUBLEBUF, HWSURFACE, FULLSCREEN] end
+             (SDL.Video.getPixelFormat ())
+             let open SDL.Prop in flags [DOUBLEBUF, HW, FULLSCREEN] end
       of NONE    => println "Any resolution is OK?"
        | SOME [] => println "None"
        | SOME rs =>
@@ -147,15 +154,17 @@
             (fn {w, h} => concat [Int.toString w, "x", Int.toString h]) rs
    ; demo ())
 
+val s2i = valOf o Int.fromString
+
 val () =
     recur (CommandLine.arguments ()) (fn lp =>
-       fn "-bpp"  :: v :: xs => (Opt.bpp  := valOf (Int.fromString v) ; lp xs)
-        | "-w"    :: v :: xs => (Opt.w    := valOf (Int.fromString v) ; lp xs)
-        | "-h"    :: v :: xs => (Opt.h    := valOf (Int.fromString v) ; lp xs)
-        | "-size" :: v :: xs => (Opt.size := valOf (Int.fromString v) ; lp xs)
-        | "-num"  :: v :: xs => (Opt.num  := valOf (Int.fromString v) ; lp xs)
-        | "-fps"  :: v :: xs => (Opt.fps  := valOf (Int.fromString v) ; lp xs)
-        | "-fs"        :: xs => (Opt.fs   := true                     ; lp xs)
+       fn "-bpp"  :: v :: xs => (Opt.bpp  := SOME (s2i v) ; lp xs)
+        | "-w"    :: v :: xs => (Opt.w    := s2i v ; lp xs)
+        | "-h"    :: v :: xs => (Opt.h    := s2i v ; lp xs)
+        | "-size" :: v :: xs => (Opt.size := s2i v ; lp xs)
+        | "-num"  :: v :: xs => (Opt.num  := s2i v ; lp xs)
+        | "-fps"  :: v :: xs => (Opt.fps  := s2i v ; lp xs)
+        | "-fs"        :: xs => (Opt.fs   := true ; lp xs)
         | x :: _             => (printlns ["Invalid option: ", x])
         | []                 => (SDL.init SDL.Init.VIDEO
                                ; after (main, SDL.quit)))

Modified: mltonlib/trunk/org/mlton/vesak/sdl/unstable/public/sdl.sig
===================================================================
--- mltonlib/trunk/org/mlton/vesak/sdl/unstable/public/sdl.sig	2007-11-29 20:08:19 UTC (rev 6229)
+++ mltonlib/trunk/org/mlton/vesak/sdl/unstable/public/sdl.sig	2007-11-30 12:38:08 UTC (rev 6230)
@@ -7,14 +7,16 @@
 (**
  * This is a fairly thin wrapper on top of the SDL API.  It should be
  * relatively easy to see the correspondence between these specifications
- * and the SDL API.
+ * and the SDL API.  For documentation on the SDL, see, for example, the
+ * [http://www.libsdl.org/cgi/docwiki.cgi/ SDL Documentation Wiki].
  *
- * For documentation on the SDL, see, for example, the
- * [http://www.libsdl.org/cgi/docwiki.cgi/ SDL Documentation Wiki].
+ * A few features of SDL are intentionally not supported.  In particular,
+ * 8-bit modes are not supported, because, frankly, they are obsolete and
+ * supporting them is not worth the trouble.
  *)
 signature SDL = sig
    structure Init : sig
-      include FLAGS where type flags_word = Word32.t
+      include FLAGS
       val TIMER : flags
       val AUDIO : flags
       val VIDEO : flags
@@ -31,16 +33,14 @@
    val quit : Unit.t Effect.t
 
    structure Prop : sig
-      include FLAGS where type flags_word = Word32.t
-      val SWSURFACE : flags
-      val HWSURFACE : flags
+      include FLAGS
+      val SW : flags
+      val HW : flags
       val ASYNCBLIT : flags
       val ANYFORMAT : flags
-      val HWPALETTE : flags
       val DOUBLEBUF : flags
       val FULLSCREEN : flags
       val OPENGL : flags
-      val OPENGLBLIT : flags
       val RESIZABLE : flags
       val NOFRAME : flags
    end
@@ -53,16 +53,32 @@
 
    structure Pixel : sig
       eqtype t
-      structure Format : sig eqtype t end
+      structure Format : sig
+         eqtype t
+         val bits : t -> Word.t
+         val bitsRGB : t -> Word.t RGB.t
+         val bitsRGBA : t -> Word.t RGBA.t
+
+         (* == Predefined Pixel Formats for Setting Video Modes ==
+          *
+          * In addition to the following predefined formats, you can also
+          * use {Video.getPixelFormat ()} with {Video.setMode}.
+          *)
+
+         val r5g6b5 : t   (** 16-bpp Hi Color *)
+         val r8g8b8 : t   (** 24-bpp True Color *)
+         val r8g8b8_8 : t (** 24-bpp True Color padded to 32-bits *)
+         val r8g8b8a8 : t (** 32-bpp True Color including an alpha channel *)
+      end
       val fromRGB : Format.t -> Word8.t RGB.t -> t
       val fromRGBA : Format.t -> Word8.t RGBA.t -> t
    end
 
    structure Surface : sig
       type 'a t
-      val pixelFormat : 'any t -> Pixel.Format.t
-      val props : 'any t -> Prop.flags
-      val dim : 'any t -> Int.t Dim.t
+      val getPixelFormat : 'any t -> Pixel.Format.t
+      val getProps : 'any t -> Prop.flags
+      val getDim : 'any t -> Int.t Dim.t
       val free : {video : no} t Effect.t
       val flip : 'dst t Effect.t
       val update : 'dst t Effect.t
@@ -72,16 +88,20 @@
       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 convertToVideo : {alpha : Bool.t} -> '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
-      val setMode : Prop.flags -> {bpp : Int.t} -> Int.t Dim.t
+      val setMode : Pixel.Format.t -> Prop.flags -> Int.t Dim.t
                     -> {video : yes} Surface.t
       val getSurface : {video : yes} Surface.t Thunk.t
       val getDriverName : String.t Thunk.t
-      val listModes : Prop.flags -> Int.t Dim.t List.t Option.t
+      val getPixelFormat : Pixel.Format.t Thunk.t
+      val getDim : Int.t Dim.t Thunk.t
+      val listModes : Pixel.Format.t -> Prop.flags
+                      -> Int.t Dim.t List.t Option.t
       val setGamma : Real.t RGB.t Effect.t
    end
 
@@ -89,7 +109,7 @@
       structure Code : sig eqtype t end
       structure Sym : SDL_KEY_SYM
       structure Mod : sig
-         include FLAGS where type flags_word = Word32.t
+         include FLAGS
          val LSHIFT : flags
          val RSHIFT : flags
          val LCTRL : flags
@@ -108,7 +128,7 @@
 
    structure Mouse : sig
       structure Button : sig
-         include FLAGS where type flags_word = Word8.t
+         include FLAGS
          val LEFT : flags
          val MIDDLE : flags
          val RIGHT : flags
@@ -116,6 +136,7 @@
          val WHEELUP : flags
       end
       val getPos : Int.t Pos.t Thunk.t
+      val setPos : Int.t Pos.t Effect.t
       val getDelta : Int.t Pos.t Thunk.t
       val getButtons : Button.flags Thunk.t
       val showCursor : Bool.t Effect.t
@@ -135,6 +156,13 @@
 
    structure Image : sig
       val loadBMP : String.t -> {video : no} Surface.t
+      (**
+       * Loads a surface from the named Windows BMP file.
+       *
+       * See also: {Surface.convert}.
+       *)
+
       val saveBMP : 'any Surface.t -> String.t Effect.t
+      (** Saves the surface as a Windows BMP file. *)
    end
 end




More information about the MLton-commit mailing list