Paweł Wieczorek avatar Paweł Wieczorek committed 2122b9a Draft

added mouseup event into system

Comments (0)

Files changed (6)

 and screen_handle =
     { screen_draw    : Video.image -> screen_action
     ; screen_keydown : Input.key -> screen_action
+    ; screen_mouseup : int -> int -> screen_action
     }
 
 (**************************************************************************
 let dummy_screen =
     { screen_draw    = (fun _ -> Continue)
     ; screen_keydown = (fun _ -> Continue)
+    ; screen_mouseup = (fun _ _ -> Continue)
     }
  *)
 
 type screen_action = ShutdownEngine | Continue | ChangeScreen of screen_handle
-and screen_handle = {
-  screen_draw : Video.image -> screen_action;
-  screen_keydown : Input.key -> screen_action;
-}
+and screen_handle = 
+    { screen_draw : Video.image -> screen_action
+    ; screen_keydown : Input.key -> screen_action
+    ; screen_mouseup : int -> int -> screen_action
+    }
 
 (**************************************************************************
  * Constants

src/Screens/GameScreen.ml

     { arena  = arena
     ; camera = camera
     } in
-  { screen_draw    = _screen_draw fresh_state
+  { dummy_screen with
+    screen_draw    = _screen_draw fresh_state
   ; screen_keydown = _screen_keydown fresh_state
   }
     
     { arena = arena
     ; camera = camera
     } in
-  { screen_draw    = _screen_draw fresh_state
+  { dummy_screen with
+    screen_draw    = _screen_draw fresh_state
   ; screen_keydown = _screen_keydown fresh_state
   }

src/Screens/MainScreen.ml

     { subscreens : subscreens
     }
 
+type buttonId
+  = START_GAME
+  | LOAD_GAME
+  | OPTIONS
+  | ABOUT
+  | EXIT
+
+(**************************************************************************
+ * Coercions
+ *)
+
+let string_of_buttonId = function
+  | START_GAME -> "START_GAME"
+  | LOAD_GAME -> "LOAD_GAME"
+  | OPTIONS -> "OPTIONS"
+  | ABOUT -> "ABOUT"
+  | EXIT -> "EXIT"
+
+
 (**************************************************************************
  * Handlers
  *)
 
 let menu_width  = 300
 
-
 let ui_contener = Panel ("Main menu", main_widget)
   where main_widget = HorizontalBox widgets
   where widgets =
-    [ Button "Start Game"
-    ; Button "Load Game"
-    ; Button "Options"
-    ; Button "About"
-    ; Button "Exit"
+    [ Button ("Start Game", START_GAME)
+    ; Button ("Load Game", LOAD_GAME)
+    ; Button ("Options", OPTIONS)
+    ; Button ("About", ABOUT)
+    ; Button ("Exit", EXIT)
     ]
 
    
         }
     } in
   let mainScreen =
-    { screen_draw    = _screen_draw img fresh_state
+    { dummy_screen with
+      screen_draw    = _screen_draw img fresh_state
     ; screen_keydown = _screen_keydown fresh_state 
     } in
   fresh_state.subscreens.play_screen    <- mainScreen;
           | KEYDOWN {keysym = KEY_F12} ->
               state.quit <- true
           | KEYDOWN {keysym = key} ->
-              handle_screen_action state (state.current_screen.screen_keydown key)
-          | _ -> ()
+              let res = state.current_screen.screen_keydown key in
+              handle_screen_action state res
+          | MOUSEBUTTONUP e ->
+              let res = state.current_screen.screen_mouseup e.mbe_x e.mbe_y in
+              handle_screen_action state res
+          | _ ->
+              ()
         end;
         if not state.quit then handle_events state
 

src/UI/UI_Algebra.ml

  * Types
  *)
 
-type ui_widget
-    = Button of string
-    | HorizontalBox of ui_widget list
+type 'action ui_widget
+    = Button of string * 'action
+    | HorizontalBox of ('action ui_widget) list
 
-type ui_contener
-    = Panel of string * ui_widget
-    | Tabs of ui_contener list
+type 'action ui_contener 
+    = Panel of string *  'action ui_widget
+    | Tabs of ('action ui_contener) list
 
 (**************************************************************************
  * 
   | n -> pred n
 
 let rec calculate_height_for_ui_widget = function
-  | Button title ->
+  | Button (title,_) ->
       UI_Button.calculate_height UI_Button.default_params
   | HorizontalBox widgets ->
       let heights = List.map calculate_height_for_ui_widget widgets in
       draw_horizontal_box rcr' surface ws
 
 and draw_ui_widget rc surface = function
-  | Button title ->
+  | Button (title,_) ->
       ignore (UI_Button.draw_button UI_Button.default_params title rc surface)
   | HorizontalBox widgets ->
       draw_horizontal_box rc surface widgets
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.