MathGame_V2/menus.ml

open Graphics ;;
exception MenuExit ;;
exception MenuStart ;;

let current_button_index = ref 0
and current_interface_index = ref 0 ;;

type 'a value_changer = {
  ptr : 'a ref ;
  min : 'a ;
  max : 'a ;
  pad : 'a ;
} ;;

type action = Nothing | Tweak of int value_changer | Warp of int

and button = {
  id : int ;
  text : string ;
  pos : Csts.rect ;
  red : int ;
  green : int ;
  blue : int ;
  actn : action 
}

and interface = {
  index : int ;
  title : string ;
  red : int ;
  green : int ;
  blue : int ;
  mutable bts : button list ;
} ;; (* circular definitions goes brrr *)

let default_button =   {
  id = -1 ;
  text = "Empty" ;
  pos = Csts.default_rect ;
  red = 128 ;
  green = 128 ;
  blue = 128 ;
  actn = Nothing ;
} ;;

let default_interface = {
  index = -1 ;
  title = "Empty" ;
  red = 128 ;
  green = 128 ;
  blue = 128 ;
  bts = []
} ;;

(* --------------------------------------------------------------------------------------------------------------------------------------------- *)
let arr_buttons = Dynamic.dyn_create default_button ;;
let arr_interfaces = Dynamic.dyn_create default_interface ;;
(* --------------------------------------------------------------------------------------------------------------------------------------------- *)
(* init *)

let init_button () =
  let res = {
    id = !current_button_index ;
    text = "Empty" ;
    pos = Csts.default_rect ;
    red = 128 ;
    green = 128 ;
    blue = 128 ;
    actn = Nothing ;
  } in
  Dynamic.dyn_add arr_buttons res ;
  incr current_button_index ;;

let build_button (text : string) (r : Csts.rect) (red : int) (green : int) (blue : int) (ac : action) =
  let res = {
    id = !current_button_index ;
    text = text ;
    pos = r ;
    red = red ;
    green = green ;
    blue = blue ;
    actn = ac
  } in
  Dynamic.dyn_add arr_buttons res ;
  incr current_button_index ;;

let init_interface () =
  let res = {
    index = -1 ;
    title = "Empty" ;
    red = 128 ;
    green = 128 ;
    blue = 128 ;
    bts = []
  } in
  Dynamic.dyn_add arr_interfaces res ;
  incr current_interface_index ;;

let build_empty_interface (title : string) (red : int) (green : int) (blue : int) =
  let res =   {
    index = !current_interface_index ;
    title = title ;
    red = 128 ;
    green = 128 ;
    blue = 128 ;
    bts = []
  } in
  Dynamic.dyn_add arr_interfaces res ;
  incr current_interface_index ;;

let build_interface (title : string) (red : int) (green : int) (blue : int) (butts : button list) =
  let res =   {
    index = !current_interface_index ;
    title = title ;
    red = 128 ;
    green = 128 ;
    blue = 128 ;
    bts = butts ; (* please *)
  } in
  Dynamic.dyn_add arr_interfaces res ;
  incr current_interface_index ;;

let build_tweak (ptr : int ref) (m : int) (mx : int) (st : int) = {
    ptr = ptr ;
    min = m;
    max = mx ;
    pad = st ;
  } ;;

(* --------------------------------------------------------------------------------------------------------------------------------------------- *)
let current_it_id = ref 0 ;;
(* --------------------------------------------------------------------------------------------------------------------------------------------- *)
(* additions *)

let add_button_to_interface (it : int) (b_id : int) =
  let interf = Dynamic.dyn_mem arr_interfaces it in
  interf.bts <- (Dynamic.dyn_mem arr_buttons b_id)::(interf.bts) ;;

let add_button_to_current (b_id : int) =
  let interf = Dynamic.dyn_mem arr_interfaces !current_it_id in
  interf.bts <- (Dynamic.dyn_mem arr_buttons b_id)::(interf.bts) ;;

(* --------------------------------------------------------------------------------------------------------------------------------------------- *)
(* printing *)

let is_within (r : Csts.rect) (x : int) (y : int) =
  r.x <= x && r.y < y && x <= r.x + r.w && y <= r.y + r.h ;;

let draw_closest (r : int) (g : int) (b : int) =
  if r+g+b <= 384 then
    set_color white
  else
    set_color black ;;

let print_button (b : button) =
  let (mx, my) = mouse_pos () in
  if is_within b.pos mx my then begin
    set_color (rgb 0 0 255) ;
    fill_rect (b.pos.x-6) (b.pos.y-6) (b.pos.w+12) (b.pos.h+12) ;
  end;
  set_color (rgb b.red b.green b.blue) ;
  fill_rect b.pos.x b.pos.y b.pos.w b.pos.h ;
  draw_closest b.red b.green b.blue ;
  set_line_width 2 ;
  Drawing.draw_string (b.pos.x+3) (b.pos.y + b.pos.h/2) b.text (min (3*b.pos.h/4-2) ((7*(b.pos.w*3/4-4)/(max 1 (String.length b.text)))/10)) ;;

let print_interface (it : interface) =
  List.iter print_button it.bts ;
  set_color black ;
  Drawing.draw_string 20 (Csts.__height__ - 40) it.title 30 ;;

let print_current_interface () =
  let interf = Dynamic.dyn_mem arr_interfaces !current_it_id in
  List.iter print_button interf.bts ;
  set_color black ;
  Drawing.draw_string 20 (Csts.__height__ - 40) interf.title 30 ;;

(* --------------------------------------------------------------------------------------------------------------------------------------------- *)
(* actions *)

let get1char () =
  if key_pressed () then
    read_key ()
  else
    '@' ;;

let move_interface (b : button) = match b.actn with
  | Nothing -> ()
  | Tweak val_ptr -> begin
    let halted = ref false in
    set_line_width 3 ;
    while not !halted do
      auto_synchronize false ;
      set_color black ;
      fill_rect (3*Csts.__width__/10) (3*Csts.__height__/10) (2*Csts.__width__/5) (2*Csts.__height__/5) ;
      set_color white ;
      Drawing.draw_string_centered (Csts.__width__/2) (13*Csts.__height__/20) b.text 20 ;
      Drawing.draw_integer (5+Csts.__width__/2) (Csts.__height__/2) !(val_ptr.ptr) 60 ;
      Drawing.draw_string (5+3*Csts.__width__/10) (11*Csts.__height__/20) "Min" 20 ;
      Drawing.draw_integer_alignedleft (5+3*Csts.__width__/10) (Csts.__height__/2) val_ptr.min 18 ;
      Drawing.draw_string (7*Csts.__width__/10-5-3*20*10/7) (11*Csts.__height__/20) "Max" 20 ;
      Drawing.draw_integer_alignedleft (7*Csts.__width__/10-5-3*20*10/7) (Csts.__height__/2) val_ptr.max 18 ;
      auto_synchronize true ;
      Unix.sleepf Csts.sleep_d ;
      match get1char () with
        | '+' -> val_ptr.ptr := min val_ptr.max (!(val_ptr.ptr) + val_ptr.pad)
        | '-' -> val_ptr.ptr := max val_ptr.min (!(val_ptr.ptr) - val_ptr.pad)
        | '\n' | ' ' -> halted := true
        | _ -> ()
    done
  end
  | Warp ne ->
    if ne = -1 then 
      raise MenuExit 
    else if ne = -2 then
      raise MenuStart
    else
      current_it_id := ne ;;

let action_on_button (mox : int) (moy : int) (b : button) =
  if is_within b.pos mox moy then begin
    (*Printf.printf "clicked\n" ;*)
    move_interface b ; 
    true
  end 
  else 
    false ;;

let stall = ref false ;;

let action_on_interface () =
  if button_down () then begin
    if !stall then 
      () 
    else begin
      stall := true ;
      let (mox, moy) = mouse_pos () in
      let rec aux = function
        | [] -> ()
        | b::t ->
          if action_on_button mox moy b then () else aux t
      in
      aux (Dynamic.dyn_mem arr_interfaces !current_it_id).bts
    end
  end 
  else
    stall := false ;;
  
(* --------------------------------------------------------------------------------------------------------------------------------------------- *)
(* Define the menu there *)

build_empty_interface "Main Menu" 128 128 128 ;;
build_empty_interface "Options  " 32 32 32 ;;

build_button "Start"      {x = Csts.__width__/2 - 150; y = 270; w = 300; h = 100} 32 255 32 (Warp (-2)) ;;
build_button "Options"    {x = Csts.__width__/2 - 150; y = 160; w = 300; h = 100} 255 32 255 (Warp 1) ;;
build_button "Exit"       {x = Csts.__width__/2 - 150; y = 50; w = 300; h = 100} 1 1 1 (Warp (-1)) ;;
build_button "Length"     {x = Csts.__width__/2 - 150; y = 380; w = 300; h = 100}  255 32 32 (Tweak (build_tweak Csts.calc_length 2 20 1)) ;;
build_button "Time"       {x = Csts.__width__/2 - 150; y = 270; w = 300; h = 100} 32 255 32 (Tweak (build_tweak Csts.time_to_ans 3 30 1)) ;;
build_button "Difficulty" {x = Csts.__width__/2 - 150; y = 160; w = 300; h = 100} 32 32 255 (Tweak (build_tweak Csts.difficulty 1 10 1)) ;;
build_button "Back"       {x = Csts.__width__/2 - 150; y = 50; w = 300; h = 100} 32 32 32 (Warp 0) ;;

(*Printf.printf "(B : %d ; I : %d)\n" arr_buttons.len arr_interfaces.len ;;*)
add_button_to_interface 0 0 ;
add_button_to_interface 0 1 ;
add_button_to_interface 0 2 ;
add_button_to_interface 1 3 ;
add_button_to_interface 1 4 ;
add_button_to_interface 1 5 ;
add_button_to_interface 1 6 ;