Event management system / dispatch (working).

This commit is contained in:
Glenn Y. Rolland 2008-03-08 09:42:54 +01:00
parent 54d4870b77
commit c51bc0e727
13 changed files with 359 additions and 58 deletions

15
Action.ml Normal file
View file

@ -0,0 +1,15 @@
(* vim: set ts=2 sw=2 et : *)
type t =
| None
| Quit
;;
type event_t = {
label : string;
};;
let execute action =
ignore action
;;

8
Common.ml Normal file
View file

@ -0,0 +1,8 @@
(* vim: set st=2 sw=2 et : *)
exception NotImplemented of string
;;
let init () =
()
;;

81
Config.ml Normal file
View file

@ -0,0 +1,81 @@
(* vim: set ts=2 sw=2 et: *)
exception ParseError
;;
type t = {
mutable config_dir : string ;
mutable video_width : int ;
mutable video_height : int ;
mutable show_fps : bool
}
let create () =
let config_dir = Printf.sprintf "%s/.justnukeit" ( Unix.getenv "HOME" )
in
{
config_dir = config_dir ;
video_width = 0 ;
video_height = 0 ;
show_fps = false
}
;;
let parse_cmdline config =
let usagemsg = ( "Usage: " ^ Sys.argv.(0) ^ " <options>\n" ) in
Arg.parse
(
Arg.align [
("-config", Arg.String (fun x -> config.config_dir <- x ) , "<dir> Load configuration from given directory");
]
) (fun x -> ignore x ) usagemsg
;;
let parse_file_load config config_file =
ignore config ;
ignore config_file
;;
let parse_file_test config config_file =
let config_perms = [Unix.R_OK; Unix.W_OK; Unix.F_OK]
in
let dir_exist =
print_string ( "Testing configuration dir '" ^ config.config_dir ^ "'\n" ) ;
try Unix.access config.config_dir config_perms ; true
with _ -> false
in
let file_exist =
print_string ( "Testing configuration file '" ^ config_file ^ "'\n" ) ;
try Unix.access config_file config_perms ; true
with _ -> false
in
print_string ( "Dir = " ^ ( string_of_bool dir_exist ) ^ " / File = "
^ ( string_of_bool file_exist ) ^ "\n" ) ;
match ( dir_exist, file_exist ) with
| ( false, false ) ->
(* create missing directory *)
Unix.mkdir config.config_dir 0o750
(* dump default config *)
| ( false, true ) -> (* problem! *)
raise ParseError
| ( true, false ) ->
(* dump default config *)
()
| ( true, true ) ->
(* load file *)
()
;;
let parse_file config =
let config_file =
Printf.sprintf "%s/config" config.config_dir ;
in
parse_file_test config config_file;
parse_file_load config config_file
;;

116
Game.ml
View file

@ -1,32 +1,55 @@
(* vim: set st=2 sw=2 et : *)
type game_t = {
level: Level.level_t ;
players: Player.player_t array ;
mutable level: Level.t ;
mutable players: Player.t option array ;
(* monsters: Monster.monster.t array ; *)
timeline : Timeline.timeline_t ;
mutable timeline : Timeline.t ;
mutable config : Config.t ;
mutable actions : Action.t list ;
mutable quit : bool ;
}
let handle_event ev =
ignore ev ; []
let create () =
let level_data = Level.create ()
and players_data = Array.make 2 (Some( Player.create() ))
and timeline_data = Timeline.create ()
and config_data = Config.create ()
in
{
level = level_data ;
players = players_data ;
timeline = timeline_data ;
config = config_data ;
actions = [] ;
quit = false ;
}
;;
let rec refresh_input () =
(* poll events *)
let match_quit ev =
if ev = Sdlevent.QUIT then true
else false
in
let configure game =
Config.parse_cmdline game.config;
Config.parse_file game.config
;;
let match_handler ev =
match ev with
let init game =
Video.init game.config;
Mouse.init () ;
Keyboard.init () ;
()
;;
let add_actions game =
let anon_handler anon_ev =
match anon_ev with
(* key events *)
| Sdlevent.KEYDOWN _ -> Keyboard.handle_event
| Sdlevent.KEYUP _ -> Keyboard.handle_event
| Sdlevent.KEYDOWN key_ev -> Keyboard.handle_event key_ev
| Sdlevent.KEYUP key_ev -> Keyboard.handle_event key_ev
(* mouse events *)
| Sdlevent.MOUSEMOTION _ -> Mouse.handle_event
| Sdlevent.MOUSEBUTTONDOWN _ -> Mouse.handle_event
| Sdlevent.MOUSEBUTTONUP _ -> Mouse.handle_event
| Sdlevent.MOUSEMOTION mouse_ev -> Mouse.handle_event mouse_ev
| Sdlevent.MOUSEBUTTONDOWN mouse_ev -> Mouse.handle_event mouse_ev
| Sdlevent.MOUSEBUTTONUP mouse_ev -> Mouse.handle_event mouse_ev
(* joystick events *)
| Sdlevent.JOYAXISMOTION _ -> Joystick.handle_event
| Sdlevent.JOYBALLMOTION _ -> Joystick.handle_event
@ -36,24 +59,57 @@ let rec refresh_input () =
(* video events *)
| Sdlevent.VIDEORESIZE _ -> Video.handle_event
| Sdlevent.VIDEOEXPOSE -> Video.handle_event
| Sdlevent.ACTIVE _ -> Video.handle_event
| Sdlevent.ACTIVE _ -> Video.handle_event
(* system events *)
| Sdlevent.QUIT -> handle_event
| Sdlevent.SYSWM -> handle_event
| Sdlevent.QUIT -> (fun x -> ignore x ; [Action.Quit] )
| Sdlevent.SYSWM -> (fun x -> ignore x ; [Action.None] )
(* user defined events *)
| Sdlevent.USER _ -> (fun x -> ignore x ; [] )
| Sdlevent.USER user_ev -> (fun x -> ignore x ; ignore user_ev ; [Action.None] )
in
let some_event = Sdlevent.poll ()
in
match some_event with
| Some ev ->
let handler = match_handler ev
and quit = match_quit ev
in
ignore ( handler ev );
if not quit then refresh_input ()
| None -> ()
| Some anon_ev ->
let specific_handler = anon_handler anon_ev
in
(* return actions resulting from selected handler *)
game.actions <- ( game.actions @ ( specific_handler anon_ev ) ) ;
()
| None ->
()
;;
(** Looping while the program is active *)
let rec loop game =
Sdltimer.delay 100 ;
(* poll events and get actions *)
add_actions game ;
(* remove and run "head" action from action list *)
(* and quit = match_quit anon_ev *)
(* if not quit then loop game *)
let remaining_actions () = ( game.actions != [] )
in
while (remaining_actions ()) do
let hd::tail = game.actions
in
game.actions <- tail ;
if hd = Action.Quit then
begin
print_string "Leaving game...\n" ;
game.quit <- true
end
else
begin
print_string "Executing action...\n" ;
Action.execute hd
end
done ;
if not game.quit then loop game
;;

View file

@ -1,5 +1,69 @@
(* vim: set st=2 sw=2 et : *)
let handle_event ev =
ignore ev ; []
module KeyMap = Map.Make(
struct
type t = Sdlkey.t
let compare x y =
let xval = Sdlkey.int_of_key x
and yval = Sdlkey.int_of_key y
in
if xval = yval then 0
else
if xval < yval then -1
else 1
end
)
type mapdata_editable_t =
| Static
| Editable
;;
type key_action_t = mapdata_editable_t * Action.t
;;
type t = {
mutable map : key_action_t KeyMap.t ;
}
;;
(** used keys *)
let keys = {
map = KeyMap.empty ;
}
let handle_event key_ev anon_ev =
let {Sdlevent.keysym = keysym} = key_ev
in
let map_fold_fun map_key map_action action_list =
if keysym = map_key then
let (sub_editable, sub_action) = map_action
in
match action_list with
| [Action.None] -> [sub_action]
| hd::tail ->
raise ( Common.NotImplemented "Keyboard: folding 2 concrete actions" )
| [] -> [sub_action]
else
action_list
in
KeyMap.fold map_fold_fun keys.map [Action.None]
;;
let init () =
(* do nothing *)
(* init an associative array of
key -> actions events
with KEY_ESCAPE -> (Action.Quit,
*)
keys.map <- KeyMap.add Sdlkey.KEY_ESCAPE ( Static, Action.Quit ) keys.map ;
keys.map <- KeyMap.add Sdlkey.KEY_q ( Static, Action.Quit ) keys.map ;
()
;;

View file

@ -18,7 +18,7 @@ type tileset_t =
| Tileset_library (* crayon, books, papers, *)
;;
type level_t = {
type t = {
size_x : int ;
size_y : int ;
items : (item_t ref) array array ;

View file

@ -1,6 +1,8 @@
PROGRAMS=justnukeit
justnukeit_OBJS= \
Common \
Config \
Position \
Timeline \
Mouse \
@ -10,6 +12,7 @@ justnukeit_OBJS= \
Level \
Player \
Video \
Action \
Game \
main

View file

@ -30,8 +30,9 @@ type t = {
keyboard_handle : string (* Keyboard.a *)
};;
(*
let handle_event ev =
let actions = (Keyboard.handle_event ev) :: (Mouse.handle_event ev)
in
actions;;
*)

View file

@ -4,7 +4,13 @@
(** Returns a list of "abstract events" generated
by this SDL event *)
let handle_event ev =
ignore ev ; []
let handle_event mouse_ev anon_ev =
ignore mouse_ev ;
ignore anon_ev ;
[Action.None]
;;
let init () =
(* do nothing *)
()
;;

View file

@ -1,5 +1,5 @@
type player_t = {
type t = {
mutable name : string ;
mutable lifes : int ;
mutable position : Position.t;

View file

@ -1,8 +1,16 @@
type timeslice_t = {
(* Action *)
action: Action.t;
label: string ;
}
type timeline_t = timeslice_t list
type t = timeslice_t list
let create () =
[];;
let add_slice timeline slice = timeline @ [slice];;
let add_action timeline action = ();;

View file

@ -1,5 +1,50 @@
(* vim: set st=2 sw=2 et : *)
let handle_event ev =
ignore ev ; []
type t = {
mutable screen : Sdlvideo.surface option;
mutable height: int;
mutable width : int
};;
let video = {
width = 0 ;
height = 0 ;
screen = None
};;
(** Initialize video, open windows, etc. *)
let init config =
Sdl.init [`VIDEO] ;
at_exit Sdl.quit ;
Sdlttf.init () ;
at_exit Sdlttf.quit ;
let bpp =
Sdlvideo.video_mode_ok
~w:config.Config.video_width
~h:config.Config.video_height
~bpp:32
[`DOUBLEBUF]
in
let screen_surface =
Sdlvideo.set_video_mode
~w:config.Config.video_width
~h:config.Config.video_height
~bpp:bpp
[`DOUBLEBUF]
in (
video.width <- config.Config.video_width ;
video.height <- config.Config.video_height ;
video.screen <- Some screen_surface
)
;;
(* set parameters & title *)
(* { screen = Sdlvideo.set_video_mode config.width config.height [`DOUBLEBUF];
} *)
let handle_event anon_ev =
ignore anon_ev ;
[]
;;

50
main.ml
View file

@ -74,6 +74,7 @@ let rec event_loop () =
*)
(*
let rec game_loop ~screen =
let image = Sdlloader.load_image image_filename
and image_from = Sdlvideo.rect 0 0 300 300
@ -84,26 +85,39 @@ let rec game_loop ~screen =
(* let action_fun = event_loop () ; *)
game_loop ~screen:screen
;;
*)
let main () =
let player1 = Player.create ()
and map1 = Level.create ()
and config = { width = 640 ; height = 480 }
in
ignore player1 ;
ignore map1 ;
(* open window *)
Sdl.init [`VIDEO];
at_exit Sdl.quit;
Sdlttf.init ();
at_exit Sdlttf.quit;
(* set parameters & title *)
let screen = Sdlvideo.set_video_mode config.width config.height [`DOUBLEBUF]
in
game_loop ~screen:screen;
(* close window *)
let game = Game.create ()
in
Printf.printf "Game.configure...\n" ;
Game.configure game ;
Game.init game ;
Printf.printf "Game.loop...\n" ;
Game.loop game ;
fun x -> ignore x
;;
main ();
(*
in
let player1 = Player.create ()
and map1 = Level.create ()
and config = Config.create ()
in
( try
let config_file = config.find ()
config.load config_file
with
exit 1;
) ;
(* { width = 640 ; height = 480 } *)
ignore player1 ;
ignore map1 ;
Game.init game config;
Game.loop game;
(* close window *)
;;
*)
Printexc.print ( main () );