Source

OCaml-Chip8 / src / display.ml

Full commit
Pierre Surply 580b59b 


























































(*
** display.ml for OCaml-Chip8 in /home/surply_p
** 
** Made by Pierre Surply
** <pierre.surply@gmail.com>
** 
** Started on  Sat Aug  4 21:38:12 2012 Pierre Surply
** Last update Sun Aug  5 10:55:48 2012 Pierre Surply
*)

let w = 64
let h = 32
let dim_pixel = 8
let s_w = w*dim_pixel
let s_h = h*dim_pixel

type t_display = 
  {
    mutable screen :	Sdlvideo.surface;
    mutable pixels :	bool array;
    mutable px_b :	Sdlvideo.surface;
    mutable px_w :	Sdlvideo.surface;
  }

let display = 
{
  screen = Sdlvideo.set_video_mode s_w s_h [`HWSURFACE];
  pixels = [||];
  px_b = Sdlvideo.create_RGB_surface [`HWSURFACE] dim_pixel dim_pixel 32 0l 0l 0l 0l;
  px_w = Sdlvideo.create_RGB_surface [`HWSURFACE] dim_pixel dim_pixel 32 0l 0l 0l 0l
}

let init_display () = 
  begin
    Sdlwm.set_caption "OCaml-Chip8 - Pierre Surply" "";
    display.pixels <- Array.make (64*32) false;
    Sdlvideo.fill_rect display.px_b (Sdlvideo.map_RGB display.px_b (0, 0, 0));
    Sdlvideo.fill_rect display.px_w (Sdlvideo.map_RGB display.px_w (0xFF, 0xFF, 0xFF))
  end

let clear_screen () =
  begin
    for y = 0 to h-1 do
      for x = 0 to w-1 do
	display.pixels.(x + y*w) <- false
      done;
    done
  end

let update_screen () =
  begin
    for y = 0 to h-1 do
      for x = 0 to w-1 do
	Sdlvideo.blit_surface ~dst_rect:(Sdlvideo.rect (x*dim_pixel) (y*dim_pixel) 0 0)
	  ~src:(if display.pixels.(x + y*w) then display.px_w else display.px_b)
	  ~dst:(display.screen) ()
      done;
    done;
    Sdlvideo.flip display.screen
  end