diff --git a/Action.ml b/Action.ml new file mode 100644 index 0000000..1d0fdd1 --- /dev/null +++ b/Action.ml @@ -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 +;; diff --git a/Common.ml b/Common.ml new file mode 100644 index 0000000..c6c5cdb --- /dev/null +++ b/Common.ml @@ -0,0 +1,8 @@ +(* vim: set st=2 sw=2 et : *) + +exception NotImplemented of string +;; + +let init () = + () +;; diff --git a/Config.ml b/Config.ml new file mode 100644 index 0000000..d104c96 --- /dev/null +++ b/Config.ml @@ -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) ^ " \n" ) in + Arg.parse + ( + Arg.align [ + ("-config", Arg.String (fun x -> config.config_dir <- x ) , " 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 +;; + diff --git a/Game.ml b/Game.ml index f7b49cb..fa3fda2 100644 --- a/Game.ml +++ b/Game.ml @@ -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 ;; diff --git a/Keyboard.ml b/Keyboard.ml index a5af842..97f8db0 100644 --- a/Keyboard.ml +++ b/Keyboard.ml @@ -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 ; + () ;; diff --git a/Level.ml b/Level.ml index b6644f8..a35facf 100644 --- a/Level.ml +++ b/Level.ml @@ -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 ; diff --git a/Makefile b/Makefile index 2362d18..da8bc97 100644 --- a/Makefile +++ b/Makefile @@ -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 diff --git a/Menu.ml b/Menu.ml index 73850ab..b0ea4f3 100644 --- a/Menu.ml +++ b/Menu.ml @@ -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;; - +*) diff --git a/Mouse.ml b/Mouse.ml index d495820..56f94be 100644 --- a/Mouse.ml +++ b/Mouse.ml @@ -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 *) + () +;; diff --git a/Player.ml b/Player.ml index a708742..2ff5264 100644 --- a/Player.ml +++ b/Player.ml @@ -1,5 +1,5 @@ -type player_t = { +type t = { mutable name : string ; mutable lifes : int ; mutable position : Position.t; diff --git a/Timeline.ml b/Timeline.ml index ca4dc70..4ca9ffc 100644 --- a/Timeline.ml +++ b/Timeline.ml @@ -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 = ();; diff --git a/Video.ml b/Video.ml index a5af842..2b048c4 100644 --- a/Video.ml +++ b/Video.ml @@ -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 ; + [] ;; diff --git a/main.ml b/main.ml index d4b4802..b8b2881 100644 --- a/main.ml +++ b/main.ml @@ -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 () );