Home My Page Projects Code Snippets Project Openings 3D graphics for Standard ML
Summary Activity SCM

SCM Repository

[sml3d] View of /src/sdl/sdl.sml
ViewVC logotype

View of /src/sdl/sdl.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6 - (download) (annotate)
Mon Jan 8 05:51:13 2007 UTC (12 years, 9 months ago) by jhr
File size: 7597 byte(s)
  Working on SDL API
(* sdl.sml
 *
 * COPYRIGHT (c) 2006 John Reppy (http://www.cs.uchicago.edu/~jhr)
 * All rights reserved.
 *)

structure SDL =
  struct

    local open SDL_Offsets in

    type uint8 = Word8.word
    type uint32 = Word32.word

    exception Error of string

    val SDL_GetError = _import "SDL_GetError" stdcall : unit -> CString.c_string;

    fun raiseError () = raise Error(CString.toML(SDL_GetError()))

  (* SDL initialization *)
    local
      val SDL_Init : _import "SDL_Init" stdcall : uint32 -> int;
      val SDL_InitSubSystem : _import "SDL_InitSubSystem" stdcall : uint32 -> int;
      val SDL_QuitSubSystem : _import "SDL_QuitSubSystem" stdcall : uint32 -> unit;
      val SDL_WasInit : _import "SDL_WasInit" stdcall : uint32 -> uint32;
      val SDL_Quit : _import "SDL_Quit" stdcall : unit -> unit;
    in
    datatype init_flags = INIT_TIMER | INIT_AUDIO | INIT_VIDEO | INIT_CDROM | INIT_JOYSTICK
    fun flg2bit INIT_TIMER = SDL_INIT_TIMER
      | flg2bit INIT_AUDIO = SDL_INIT_AUDIO
      | flg2bit INIT_VIDEO = SDL_INIT_VIDEO
      | flg2bit INIT_CDROM = SDL_INIT_CDROM
      | flg2bit INIT_JOYSTICK = SDL_INIT_JOYSTICK
    fun flgs2bits flags = List.foldl (fn (flg, w) => Word32.orb(w, flg2bit flg)) 0w0 flags
    fun init flags = let
	  val sts = SDL_Init (flgs2bits flags)
	  in
	    if (sts <> 0) then raiseError() else ()
	  end
    fun initSubSystem flags = let
	  val sts = SDL_InitSubSystem (flgs2bits flags)
	  in
	    if (sts <> 0) then raiseError() else ()
	  end
    fun quitSubSystem flags = SDL_QuitSubSystem (flgs2bits flags)
    val quit = SDL_Quit
    end

  (***** SDL Keyboard and keysym support *****)
    datatype keysym = KEYSYM of {
	scancode : uint8,
	sym : uint32,
	mod : uint32,
	unicode : uint16
      }

  (***** SDL Events *****)
  (* SML representation of SDL event *)
    datatype sdl_event
      = NoEvent
      | ActiveEvent of {gain : bool, mask : Word8.word}
      | KeyboardEvent of {
	    down : bool,
	    which : Word8.word,
	    state : bool,	(* true means pressed *)
	    keysym : keysym
	  }
      | MouseMotionEvent of {
	    which : Word8.word,
	    state : Word8.word,
	    x : Word16.word,
	    y : Word16.word,
	    xrel : Int16.int,
	    yrel : Int16.int
	  }
      | MouseButtonEvent of {
	    which : Word8.word,
	    button : Word8.word,
	    state : Word8.word,
	    x : Word16.word,
	    y : Word16.word
	  }
      | JoyAxisEvent of {
	    which : Word8.word,
	    axis : Word8.word,
	    value : Int16.int
	  }
      | JoyBallEvent of {
	    which : Word8.word,
	    ball : Word8.word,
	    xrel : Int16.int,
	    yrel : Int16.int
	  }
      | JoyHatEvent of {
	    which : Word8.word,
	    hat : Word8.word,
	    value : Word8.word (* ?? convert to datatype? *)
	  }
      | JoyButtonEvent of {
	    which : Word8.word,
	    button : Word8.word,
	    state : bool	(* true means pressed *)
	  }
      | ResizeEvent of {
	    w : int,
	    h : int
	  }
      | ExposeEvent
      | QuitEvent
      | UserEvent of {
	    code : int,
	    data1 : MLton.Pointer.t,
	    data2 : MLton.Pointer.t
	  }
      | SysWMEvent of MLton.Pointer.t
    local
    (* predefined event masks *)
      fun eventMask x = Word32.lshift(1, x)
      fun decodeActiveEvent p = ActiveEvent{
	      gain = byte2bool(SDL_ActiveEvent.get'gain p),
	      mask = SDL_ActiveEvent.get'mask p
	    }
      fun decodeKeyboardEvent p = KeyboardEvent{
	      down = SDL_KeyboardEvent.get'down p,
	      which = SDL_KeyboardEvent.get'which p,
	      state = SDL_KeyboardEvent.get'state p,	(* convert to bool *)
	      keysym = let
		val p' = SDL_KeyboardEvent.offset'keysym p
		in
		  ??
		end
	    }
      fun decodeMouseMotionEvent p = MouseMotionEvent{
	      which = SDL_MouseMotionEvent.get'which p,
	      state = SDL_MouseMotionEvent.get'state p,
	      x = SDL_MouseMotionEvent.get'x p,
	      y = SDL_MouseMotionEvent.get'y p,
	      xrel = SDL_MouseMotionEvent.get'xrel p,
	      yrel = SDL_MouseMotionEvent.get'yrel p
	    }
      fun decodeMouseButtonEvent p = MouseButtonEvent{
	      which = SDL_MouseButtonEvent.get'which p,
	      button = SDL_MouseButtonEvent.get'button p,
	      state = SDL_MouseButtonEvent.get'state p,
	      x = SDL_MouseButtonEvent.get'x p,
	      y = SDL_MouseButtonEvent.get'y p
	    }
      fun decodeJoyAxisEvent p = JoyAxisEvent{
	      which = SDL_JoyAxisEvent.get'which p,
	      axis = SDL_JoyAxisEvent.get'axis p,
	      value = SDL_JoyAxisEvent.get'value p
	    }
      fun decodeJoyBallEvent p = JoyBallEvent{
	    which = SDL_JoyBallEvent.get'which p,
	    ball = SDL_JoyBallEvent.get'ball p,
	    xrel = SDL_JoyBallEvent.get'xrel p,
	    yrel = SDL_JoyBallEvent.get'yrel p
	    }
      fun decodeJoyHatEvent p = JoyHatEvent{
	    which = SDL_JoyHatEvent.get'which p,
	    hat = SDL_JoyHatEvent.get'hat p,
	    value = SDL_JoyHatEvent.get'value p (* ?? convert to datatype? *)
	    }
      fun decodeJoyButtonEvent p = JoyButtonEvent{
	    which = SDL_JoyButtonEvent.get'which p,
	    button = SDL_JoyButtonEvent.get'button p,
	    state = SDL_JoyButtonEvent.get'state p	(* true means pressed *)
	    }
      fun decodeResizeEvent p = ResizeEvent{
	    w = SDL_ResizeEvent.get'w p,
	    h = SDL_ResizeEvent.get'h p
	    }
      fun decodeUserEvent p = UserEvent{
	    code = SDL_UserEvent.get'code p,
	    data1 = SDL_UserEvent.get'data1 p,
	    data2 = SDL_UserEvent.get'data2 p
	    }
      fun decodeSysWMEvent p = SysWMEvent(SDL_SysWMEvent.get'msg p)
    (* SDL event functions *)
      val SDL_PumpEvents = _import "SDL_PumpEvents" stdcall : unit -> unit;
      val SDL_PeepEvents = _import "SDL_PeepEvents" stdcall : MLton.Pointer.t * int * uint32 * uint32 -> int;
      val SDL_PollEvent = _import "SDL_PollEvent" stdcall : MLton.Pointer.t -> int;
      val SDL_WaitEvent = _import "SDL_WaitEvent" stdcall : MLton.Pointer.t -> int;
      val SDL_PushEvent = _import "SDL_PushEvent" stdcall : MLton.Pointer.t -> int;
      val SDL_SetEventFilter = _import "SDL_SetEventFilter" stdcall : MLton.Pointer.t -> unit;
      val SDL_GetEventFilter = _import "SDL_GetEventFilter" stdcall : unit -> MLton.Pointer.t;
      val SDL_EventState = _import "SDL_EventState" stdcall : uint8 * int -> Uint8;
    in
    (* map a pointer to an C SDL event to its ML representation *)
    fun decodeSDLEvent p = let
	  val code = SDL_Event.get'type p
	  in
	    if code = SDL_ACTIVEEVENT then decodeActiveEvent p
	    else if code = SDL_KEYDOWN then decodeKeyboardEvent p
	    else if code = SDL_KEYUP then decodeKeyboardEvent p
	    else if code = SDL_MOUSEMOTION then decodeMouseMotionEvent p
	    else if code = SDL_MOUSEBUTTONDOWN then decodeMouseButtonEvent p
	    else if code = SDL_MOUSEBUTTONUP then decodeMouseButtonEvent p
	    else if code = SDL_JOYAXISMOTION then decodeJoyAxisEvent p
	    else if code = SDL_JOYBALLMOTION then decodeJoyBallEvent p
	    else if code = SDL_JOYHATMOTION then decodeJoyHatEvent p
	    else if code = SDL_JOYBUTTONDOWN then decodeJoyButtonEvent p
	    else if code = SDL_JOYBUTTONUP then decodeJoyButtonEvent p
	    else if code = SDL_QUIT then QuitEvent p
	    else if code = SDL_SYSWMEVENT then decodeSysWMEvent p
	    else if code = SDL_VIDEORESIZE then decodeResizeEvent p
	    else if code = SDL_VIDEOEXPOSE then ExposeEvent p
	    else if code = SDL_USEREVENT then decodeUserEvent p
	    else NoEvent
	  end
    fun pollEvent () = let
	  val buf = CAlloc.malloc SDL_Event.size
	  val sts = SDL_PollEvent buf
	  val evt = if sts = 0 then NoEvent else decodeSDLEvent buf
	  in
	    CAlloc.free buf;
	    evt
	  end
    end (* local *)

    end (* local open SDL_Offsets *)
  end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0