Source

OCaml-Chip8 / src / events.ml

Full commit
(*
** events.ml for OCaml-Chip8 in /home/surply_p
** 
** Made by Pierre Surply
** <pierre.surply@gmail.com>
** 
** Started on  Sat Aug  4 22:15:13 2012 Pierre Surply
** Last update Sun Aug  5 15:40:40 2012 Pierre Surply
*)

type t_events =
  {
    mutable keys : bool array;
    mutable quit : bool
  }

let events = 
{
  keys = [||];
  quit = false
}

let init_events () =
  begin
    events.keys <- Array.make 16 false;
    events.quit <- false
  end


let keysym2id = function
  | Sdlkey.KEY_KP0 ->		0x0
  | Sdlkey.KEY_KP7 ->		0x1
  | Sdlkey.KEY_KP8 ->		0x2
  | Sdlkey.KEY_KP9 ->		0x3
  | Sdlkey.KEY_KP4 ->		0x4
  | Sdlkey.KEY_KP5 ->		0x5
  | Sdlkey.KEY_KP6 ->		0x6
  | Sdlkey.KEY_KP1 ->		0x7
  | Sdlkey.KEY_KP2 ->		0x8
  | Sdlkey.KEY_KP3 ->		0x9
  | Sdlkey.KEY_KP_PERIOD ->	0xA
  | Sdlkey.KEY_KP_DIVIDE ->	0xB
  | Sdlkey.KEY_KP_MULTIPLY ->	0xC
  | Sdlkey.KEY_KP_MINUS ->	0xD
  | Sdlkey.KEY_KP_PLUS ->	0xE
  | Sdlkey.KEY_KP_ENTER ->	0xF
  | _ ->			-1

let rec update_events () = 
  begin
    let event = Sdlevent.poll () in
    if Option.is_some event then
      begin
	begin
	  match Option.get event with
	    | Sdlevent.QUIT -> events.quit <- true
	    | Sdlevent.KEYDOWN kevent ->
	      let id = keysym2id (kevent.Sdlevent.keysym) in
	      if id >= 0 then
		events.keys.(id) <- true
	    | Sdlevent.KEYUP kevent ->
	      let id = keysym2id (kevent.Sdlevent.keysym) in
	      if id >= 0 then
		events.keys.(id) <- false
	    | _ -> ()
	end;
	update_events ()
      end
  end

let rec wait_events () = 
  begin
    let event = Sdlevent.poll () in
    if Option.is_some event then
      begin
	match Option.get event with
	  | Sdlevent.QUIT -> events.quit <- true; 0xF
	  | Sdlevent.KEYDOWN kevent ->
	    let id = keysym2id (kevent.Sdlevent.keysym) in
	    if id >= 0 then
	      begin
		events.keys.(id) <- true;
		id
	      end
	    else
	      wait_events ()
	  | _ -> wait_events ()
      end
    else
      wait_events ()
  end