mp2i-vms.fr
396 lines
15 KiB
OCaml
396 lines
15 KiB
OCaml
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 ;
|
|
min_update : ('a ref) list ; (* after this value changes, these values will be set to min(their_value, this_value-1) *)
|
|
max_update : ('a ref) list ; (* after this value changes, these values will be set to max(their_value, this_value+1) *)
|
|
} ;;
|
|
|
|
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) (mi : (int ref) list) (sp : (int ref) list) = {
|
|
ptr = ptr ;
|
|
min = m;
|
|
max = mx ;
|
|
pad = st ;
|
|
min_update = mi ;
|
|
max_update = sp ;
|
|
} ;;
|
|
|
|
(* --------------------------------------------------------------------------------------------------------------------------------------------- *)
|
|
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-50)/(max 1 (String.length b.text)))/10)) ;
|
|
match b.actn with
|
|
| Tweak v ->
|
|
Drawing.draw_integer_alignedright (b.pos.x + b.pos.w) (b.pos.y + b.pos.h/2) !(v.ptr) 15
|
|
| _ -> () ;;
|
|
|
|
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 1/2 *)
|
|
|
|
let get1char () =
|
|
if key_pressed () then
|
|
read_key ()
|
|
else
|
|
'@' ;;
|
|
|
|
let change_other (reference : int) (mins : (int ref) list) (maxs : (int ref) list) =
|
|
let rec aux = function
|
|
| ([], []) ->
|
|
()
|
|
| (hmin::tmin, []) ->
|
|
hmin := min (!hmin) (reference -1) ;
|
|
aux (tmin, [])
|
|
| ([], hmax::tmax) ->
|
|
hmax := max (!hmax) (reference +1) ;
|
|
aux ([], tmax)
|
|
| (hmin::tmin, hmax::tmax) ->
|
|
hmin := min (!hmin) (reference -1) ;
|
|
hmax := max (!hmax) (reference +1) ;
|
|
aux (tmin, tmax)
|
|
in aux (mins, maxs) ;;
|
|
|
|
let offset_pm = 40 ;;
|
|
let size_pm = (Csts.__width__ - 2*offset_pm) /11 ;;
|
|
|
|
let draw_rect_pm (x : int) (y : int) (w: int) (h : int) (red : int) (green : int) (blue : int) =
|
|
let (mx, my) = mouse_pos () in
|
|
if is_within {x = x; y = y; w = w; h = h} mx my then begin
|
|
set_color (rgb 0 255 0) ;
|
|
fill_rect x y w h ;
|
|
set_color (rgb red green blue) ;
|
|
fill_rect (x+6) (y+6) (w-12) (h-12)
|
|
end
|
|
else begin
|
|
set_color (rgb red green blue) ;
|
|
fill_rect x y w h
|
|
end ;;
|
|
|
|
let draw_incrdecr () =
|
|
draw_rect_pm (offset_pm) (offset_pm) size_pm size_pm 255 0 0;
|
|
draw_rect_pm (Csts.__width__/11 + offset_pm) (offset_pm) size_pm size_pm 255 0 0;
|
|
draw_rect_pm (2*Csts.__width__/11 + offset_pm) (offset_pm) size_pm size_pm 255 0 0;
|
|
draw_rect_pm (3*Csts.__width__/11 + offset_pm) (offset_pm) size_pm size_pm 255 0 0;
|
|
draw_rect_pm (4*Csts.__width__/11 + offset_pm) (offset_pm) size_pm size_pm 255 0 0;
|
|
draw_rect_pm (10*Csts.__width__/11 - offset_pm) (offset_pm) size_pm size_pm 0 0 255;
|
|
draw_rect_pm (9*Csts.__width__/11 - offset_pm) (offset_pm) size_pm size_pm 0 0 255;
|
|
draw_rect_pm (8*Csts.__width__/11 - offset_pm) (offset_pm) size_pm size_pm 0 0 255;
|
|
draw_rect_pm (7*Csts.__width__/11 - offset_pm) (offset_pm) size_pm size_pm 0 0 255;
|
|
draw_rect_pm (6*Csts.__width__/11 - offset_pm) (offset_pm) size_pm size_pm 0 0 255;;
|
|
|
|
let draw_digits_incrdecr () =
|
|
set_color white ;
|
|
Drawing.draw_string_centered (offset_pm + size_pm/2) (offset_pm + size_pm/2) "min" (size_pm/6) ;
|
|
Drawing.draw_integer (offset_pm + Csts.__width__/11 + size_pm/2) (offset_pm + size_pm/2) 1 (size_pm/3) ;
|
|
Drawing.draw_integer (offset_pm + 2*Csts.__width__/11 + size_pm/2) (offset_pm + size_pm/2) 10 (size_pm/3) ;
|
|
Drawing.draw_integer (offset_pm + 3*Csts.__width__/11 + size_pm/2) (offset_pm + size_pm/2) 100 (size_pm/3) ;
|
|
Drawing.draw_integer (offset_pm + 4*Csts.__width__/11 + size_pm/2) (offset_pm + size_pm/2) 500 (size_pm/3) ;
|
|
|
|
Drawing.draw_string_centered (-offset_pm + 10*Csts.__width__/11 + size_pm/2) (offset_pm + size_pm/2) "max" (size_pm/6) ;
|
|
Drawing.draw_integer (-offset_pm + 9*Csts.__width__/11 + size_pm/2) (offset_pm + size_pm/2) 1 (size_pm/3) ;
|
|
Drawing.draw_integer (-offset_pm + 8*Csts.__width__/11 + size_pm/2) (offset_pm + size_pm/2) 10 (size_pm/3) ;
|
|
Drawing.draw_integer (-offset_pm + 7*Csts.__width__/11 + size_pm/2) (offset_pm + size_pm/2) 100 (size_pm/3) ;
|
|
Drawing.draw_integer (-offset_pm + 6*Csts.__width__/11 + size_pm/2) (offset_pm + size_pm/2) 500 (size_pm/3) ;;
|
|
|
|
(* --------------------------------------------------------------------------------------------------------------------------------------------- *)
|
|
(* actions 2/2 *)
|
|
|
|
let stall_pm = ref false ;;
|
|
let use_incrdecr (val_ptr : int value_changer) =
|
|
if button_down () then begin
|
|
if !stall_pm then
|
|
()
|
|
else begin
|
|
stall_pm := true ;
|
|
let (mox, moy) = mouse_pos () in
|
|
if moy >= offset_pm && moy <= offset_pm + size_pm then begin
|
|
match mox with
|
|
| x when x >= offset_pm && x <= offset_pm + size_pm ->
|
|
val_ptr.ptr := val_ptr.min
|
|
| x when x >= offset_pm + Csts.__width__/11 && x <= offset_pm + Csts.__width__/11 + size_pm ->
|
|
val_ptr.ptr := max val_ptr.min (!(val_ptr.ptr) - 1)
|
|
| x when x >= offset_pm + 2*Csts.__width__/11 && x <= offset_pm + 2*Csts.__width__/11 + size_pm ->
|
|
val_ptr.ptr := max val_ptr.min (!(val_ptr.ptr) - 10)
|
|
| x when x >= offset_pm + 3*Csts.__width__/11 && x <= offset_pm + 3*Csts.__width__/11 + size_pm ->
|
|
val_ptr.ptr := max val_ptr.min (!(val_ptr.ptr) - 100)
|
|
| x when x >= offset_pm + 4*Csts.__width__/11 && x <= offset_pm + 4*Csts.__width__/11 + size_pm ->
|
|
val_ptr.ptr := max val_ptr.min (!(val_ptr.ptr) - 500)
|
|
|
|
| x when x >= 6*Csts.__width__/11 - offset_pm && x <= 6*Csts.__width__/11 - offset_pm + size_pm ->
|
|
val_ptr.ptr := min val_ptr.max (!(val_ptr.ptr) + 500)
|
|
| x when x >= 7*Csts.__width__/11 - offset_pm && x <= 7*Csts.__width__/11 - offset_pm + size_pm ->
|
|
val_ptr.ptr := min val_ptr.max (!(val_ptr.ptr) + 100)
|
|
| x when x >= 8*Csts.__width__/11 - offset_pm && x <= 8*Csts.__width__/11 - offset_pm + size_pm ->
|
|
val_ptr.ptr := min val_ptr.max (!(val_ptr.ptr) + 10)
|
|
| x when x >= 9*Csts.__width__/11 - offset_pm && x <= 9*Csts.__width__/11 - offset_pm + size_pm ->
|
|
val_ptr.ptr := min val_ptr.max (!(val_ptr.ptr) + 1)
|
|
| x when x >= 10*Csts.__width__/11 - offset_pm && x <= 10*Csts.__width__/11 - offset_pm + size_pm ->
|
|
val_ptr.ptr := val_ptr.max
|
|
| _ -> ()
|
|
end
|
|
end
|
|
end
|
|
else
|
|
stall_pm := false ;;
|
|
|
|
let move_interface (b : button) = match b.actn with
|
|
| Nothing -> ()
|
|
| Tweak val_ptr -> begin
|
|
let halted = ref false in
|
|
set_color black ;
|
|
Drawing.draw_string_centered (Csts.__width__/2) (Csts.__height__ - 50) "press space to confirm" 15 ;
|
|
set_line_width 3 ;
|
|
while not !halted do
|
|
auto_synchronize false ;
|
|
draw_incrdecr () ;
|
|
draw_digits_incrdecr () ;
|
|
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_alignedright (7*Csts.__width__/10-5) (Csts.__height__/2) val_ptr.max 18 ;
|
|
auto_synchronize true ;
|
|
use_incrdecr val_ptr ;
|
|
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 ;
|
|
change_other !(val_ptr.ptr) val_ptr.min_update val_ptr.max_update
|
|
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_empty_interface "End screen" 32 32 200 ;;
|
|
|
|
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 "Minimum" {x = Csts.__width__/2 - 200; y = 710; w = 400; h = 100} 255 128 32 (Tweak (build_tweak Csts.n_inf 1 1000 1 [] [Csts.n_sup])) ;;
|
|
build_button "Maximum" {x = Csts.__width__/2 - 200; y = 600; w = 400; h = 100} 128 255 32 (Tweak (build_tweak Csts.n_sup 1 1000 1 [Csts.n_inf] [])) ;;
|
|
build_button "Length" {x = Csts.__width__/2 - 200; y = 490; w = 400; h = 100} 255 32 32 (Tweak (build_tweak Csts.calc_length 2 12 1 [] [])) ;;
|
|
build_button "Answer time" {x = Csts.__width__/2 - 200; y = 380; w = 400; h = 100} 32 192 32 (Tweak (build_tweak Csts.time_to_ans 3 60 1 [] [])) ;;
|
|
build_button "Total time" {x = Csts.__width__/2 - 200; y = 270; w = 400; h = 100} 32 255 32 (Tweak (build_tweak Csts.total_time 15 3600 1 [] [])) ;;
|
|
build_button "Difficulty" {x = Csts.__width__/2 - 200; y = 160; w = 400; h = 100} 32 32 255 (Tweak (build_tweak Csts.difficulty 1 10 1 [] [])) ;;
|
|
build_button "Back" {x = Csts.__width__/2 - 200; y = 50; w = 400; h = 100} 32 32 32 (Warp 0) ;;
|
|
|
|
build_button "Exit" {x = Csts.__width__/2 - 150; y = 50; w = 300; h = 100} 1 1 1 (Warp (-1)) ;;
|
|
build_button "Main Menu" {x = Csts.__width__/2 - 150; y = 160; w = 300; h = 100} 128 128 128 (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 ;
|
|
add_button_to_interface 1 7 ;
|
|
add_button_to_interface 1 8 ;
|
|
add_button_to_interface 1 9 ;
|
|
add_button_to_interface 2 10 ;
|
|
add_button_to_interface 2 11 ; |