justnukeit/main.ml

94 lines
1.9 KiB
OCaml
Raw Normal View History

2008-02-18 08:55:16 +00:00
(* vim: set ts=2 sw=2 et : *)
open Event;;
2008-02-19 22:26:01 +00:00
type config_t = {
mutable width : int ;
mutable height : int;
}
type notification_t =
| Graphics_status of Graphics.status
| Tick
;;
2008-02-18 08:55:16 +00:00
type game_event_t =
| MoveLeft
| MoveRight
| MoveUp
| MoveDown
| Action
| ActionTwo
| Help
| Quit
| NoEvent
2008-02-18 08:55:16 +00:00
;;
2008-02-19 22:26:01 +00:00
let image_filename = "images/test.png"
;;
let string_of_keyboard_event event =
try
let chr = Sdlkey.char_of_key event.Sdlevent.keysym
in
String.make 1 chr
with
| Invalid_argument _ -> "unknown-key"
;;
let rec event_loop () =
print_endline "Event_loop...";
Sdltimer.delay 20;
let match_event event = (
match event with
| Sdlevent.KEYDOWN {Sdlevent.keysym=Sdlkey.KEY_ESCAPE} ->
print_endline "You pressed escape! The fun is over now."
2008-02-19 22:26:01 +00:00
| Sdlevent.KEYDOWN event ->
2008-02-20 00:24:56 +00:00
Keyboard.handle_event event
2008-02-19 22:26:01 +00:00
let keystr = string_of_keyboard_event event
in
print_endline ("You pressed " ^ keystr);
event_loop ()
| _ ->
event_loop ()
) in
2008-02-20 00:24:56 +00:00
let event_opt = Sdlevent.poll ()
in
2008-02-19 22:26:01 +00:00
match event_opt with
| None -> event_loop ()
| Some event -> match_event event;
;;
let game_loop ~screen =
let image = Sdlloader.load_image image_filename
and image_from = Sdlvideo.rect 0 0 300 300
and image_to = Sdlvideo.rect 100 0 300 300
in
Sdlvideo.blit_surface ~src:image ~src_rect:image_from ~dst:screen ~dst_rect:image_to ();
Sdlvideo.flip screen;
2008-02-20 00:24:56 +00:00
let action_fun = event_loop ();
game_loop screen
2008-02-18 08:55:16 +00:00
;;
let main () =
let player1 = Player.create ()
and map1 = Maze.create ()
2008-02-19 22:26:01 +00:00
and config = { width = 640 ; height = 480 }
2008-02-18 08:55:16 +00:00
in
ignore player1 ;
ignore map1 ;
(* open window *)
2008-02-19 22:26:01 +00:00
Sdl.init [`VIDEO];
at_exit Sdl.quit;
Sdlttf.init ();
at_exit Sdlttf.quit;
(* set parameters & title *)
2008-02-19 22:26:01 +00:00
let screen = Sdlvideo.set_video_mode config.width config.height [`DOUBLEBUF]
in
game_loop ~screen:screen;
(* close window *)
2008-02-18 08:55:16 +00:00
;;
main ();