Commits

Paweł Wieczorek committed 4be8bc2 Draft

MainScreen tests clickMap

Comments (0)

Files changed (2)

src/Screens/MainScreen.ml

 open Screen;;
 open UI;;
 open UI_Algebra;;
+open ClickMap;;
 
 (**************************************************************************
  * Types
  *)
 
+type buttonId
+  = START_GAME
+  | LOAD_GAME
+  | OPTIONS
+  | ABOUT
+  | EXIT
+
 type subscreens =
     { mutable play_screen    : screen_handle
     ; mutable options_screen : screen_handle
 
 type state =
     { subscreens : subscreens
+    ; mutable click_map      : buttonId clickMap
     }
 
-type buttonId
-  = START_GAME
-  | LOAD_GAME
-  | OPTIONS
-  | ABOUT
-  | EXIT
-
 (**************************************************************************
  * Coercions
  *)
   let padding_ver = (width - menu_width ) / 2 in
   let padding_hor = (height - menu_height ) / 2 in
   let rc          = (padding_ver, padding_hor, menu_width, menu_height) in
+  state.click_map <@ add_rect rc ABOUT;
   draw_ui_contener rc surface ui_contener;
   Continue
 
 
 let _screen_mouseup state mx my =
   Printf.printf "Mouse up at (%u, %u)\n%!" mx my;
+  begin match (find_clicked (mx,my) state.click_map) with
+      | None -> Printf.printf "not found\n%!"
+      | Some _ -> Printf.printf "found\n%!"
+  end;
   Continue
 
 let _screen_mousedown state mx my =
         { play_screen    = dummy_screen
         ; options_screen = dummy_screen
         }
+    ; click_map  = empty
     } in
   let mainScreen =
     { dummy_screen with
 
 let is_empty cmap = List.length cmap == 0
 
-let add_rect rect a cmap = (rect,a) :: cmap
-
 let rem_rect rect cmap = 
   let p (rect', _) = rect <> rect' in
   List.filter p cmap
 
+let add_rect rect a cmap = (rect,a) :: rem_rect rect cmap
 
 let find_clicked (mx,my) cmap = 
-  let in_range a b c = a <= c && c <= b in
+  let in_range a b c = a <= c && c <= (a+b) in
   let p ( (x',y',w',h'), _ ) = 
     in_range x' w' mx && in_range y' h' my in
   match List.filter p cmap with