Initial commit

This commit is contained in:
Alexandre 2024-06-15 18:40:21 +02:00
commit 9e81484dff
5 changed files with 322 additions and 0 deletions

4
README.md Normal file
View File

@ -0,0 +1,4 @@
This is a less broken version of the Math Game
The way you play this : an arithmetic equation is shown on the screen, answer fast to earn more points
[Right now the core game function hasn't been implemented so please wait]

BIN
a.out Executable file

Binary file not shown.

BIN
main.cmi Normal file

Binary file not shown.

BIN
main.cmo Normal file

Binary file not shown.

318
main.ml Normal file
View File

@ -0,0 +1,318 @@
open Graphics ;;
Random.self_init () ;;
(* Dynamic getchar function *)
let get1char () =
let termio = Unix.tcgetattr Unix.stdin in
let () =
Unix.tcsetattr Unix.stdin Unix.TCSADRAIN
{ termio with Unix.c_icanon = false } in
let res = input_char stdin in
Unix.tcsetattr Unix.stdin Unix.TCSADRAIN termio;
res
(* Some digit display functions *)
let rec ln10 n = match n with
| k when k < 0 -> failwith "Are you sure about that ?"
| k when k < 10 -> 0
| k -> 1 + ln10 (k/10) ;;
let delta i j =
if i = j then 1 else 0 ;;
let abs n =
if n > 0 then n else -n ;;
let draw_integer x0 y n0 len =
(* 7-seg display *)
set_line_width (max 1 (len/4));
let n = ref n0 in
let size = ln10 (abs n0) in
let offset = ref (size*(len*11/7)/2) in
let initial_i = ref 1 in
if !n < 0 then begin
offset := (size+1)*(len*11/7)/2;
let x = x0 + !offset - (size+1)*(len*11/7) in
draw_poly_line [|(x-len/2, y); (x+len/2, y)|];
n := !n * (-1);
decr initial_i ;
end;
for i = !initial_i to (size + !initial_i) do
let x = x0 + !offset - i*(len*11/7) in
if Array.mem (!n mod 10) [|0; 4; 5; 6; 7; 8; 9|] then
draw_poly_line [|(x-len/2, y+len); (x-len/2, y)|];
if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 7; 8; 9|] then
draw_poly_line [|(x-len/2, y+len); (x+len/2, y+len)|];
if Array.mem (!n mod 10) [|0; 1; 2; 3; 4; 7; 8; 9|] then
draw_poly_line [|(x+len/2, y+len); (x+len/2, y)|];
if Array.mem (!n mod 10) [|2; 3; 4; 5; 6; 8; 9|] then
draw_poly_line [|(x-len/2, y); (x+len/2, y)|];
if Array.mem (!n mod 10) [|0; 1; 3; 4; 5; 6; 7; 8; 9|] then
draw_poly_line [|(x+len/2, y-len); (x+len/2, y)|];
if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 8; 9|] then
draw_poly_line [|(x-len/2, y-len); (x+len/2, y-len)|];
if Array.mem (!n mod 10) [|0; 2; 6; 8|] then
draw_poly_line [|(x-len/2, y-len); (x-len/2, y)|];
n := !n/10;
done ;;
let draw_integer_alignedleft x0 y n0 len =
(* 7-seg display 2 *)
set_line_width (max 1 (len/4));
let n = ref n0 in
let size = ln10 (abs n0) in
let offset = ref (((size+1)*len)/2) in
let initial_i = ref 0 in
if !n < 0 then begin
offset := ((size+2)*len)/2;
draw_poly_line [|(x0, y); (x0+len/2, y)|];
n := !n * (-1);
incr initial_i ;
end;
for i = !initial_i to (size + !initial_i) do
let x = x0 + (!offset - i*len)*11/7 in
if Array.mem (!n mod 10) [|0; 4; 5; 6; 7; 8; 9|] then
draw_poly_line [|(x, y+len); (x, y)|];
if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 7; 8; 9|] then
draw_poly_line [|(x, y+len); (x+len, y+len)|];
if Array.mem (!n mod 10) [|0; 1; 2; 3; 4; 7; 8; 9|] then
draw_poly_line [|(x+len, y+len); (x+len, y)|];
if Array.mem (!n mod 10) [|2; 3; 4; 5; 6; 8; 9|] then
draw_poly_line [|(x, y); (x+len, y)|];
if Array.mem (!n mod 10) [|0; 1; 3; 4; 5; 6; 7; 8; 9|] then
draw_poly_line [|(x+len, y-len); (x+len, y)|];
if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 8; 9|] then
draw_poly_line [|(x, y-len); (x+len, y-len)|];
if Array.mem (!n mod 10) [|0; 2; 6; 8|] then
draw_poly_line [|(x, y-len); (x, y)|];
n := !n/10;
done ;;
(* Arithmetical functions *)
type calcul =
Val of int |
Plus of calcul * calcul |
Minus of calcul * calcul |
Exp of calcul * int | (* u^n *)
Multiply of calcul * calcul ;;
let print_sign c x y len = match c with
| '+' -> draw_poly_line [|(x, y); (x+len, y)|]; draw_poly_line [|(x+len/2, y+len/2); (x+len/2, y-len/2)|]
| '-' -> draw_poly_line [|(x, y); (x+len, y)|]
| '*' -> draw_poly_line [|(x+len/4, y+len/2); (x+3*len/4, y-len/2)|]; draw_poly_line [|(x+len/4, y-len/2); (x+3*len/4, y+len/2)|]
| '^' -> () (* TODO *)
| '(' ->
moveto (x+len) (y+len+len/5);
set_line_width (max 1 (len/4));
set_color black ;
curveto (x+len/2, y) (x+len/2, y) (x+len, y-len-len/5)
| ')' ->
moveto (x) (y+len+len/5);
set_line_width (max 1 (len/4));
set_color black ;
curveto (x+len/2, y) (x+len/2, y) (x, y-len-len/5)
| _ -> () ;;
let print_math fm x0 y0 size =
let current_x = ref x0 in
let current_y = ref y0 in
let rec aux f = match f with
| Val x ->
current_x := !current_x + size/3;
draw_integer_alignedleft (!current_x) !current_y x size;
current_x := !current_x + (size*(2 + ln10 (abs x)));
current_x := !current_x + size/3
| Plus (a, b) ->
aux a;
print_sign '+' !current_x !current_y size;
current_x := !current_x + size*11/7;
aux b
| Minus (a, b) ->
aux a;
print_sign '-' !current_x !current_y size;
current_x := !current_x + size*11/7;
aux b
| Multiply (a, b) ->
aux a;
print_sign '*' !current_x !current_y size;
current_x := !current_x + size*11/7;
aux b
| Exp (a, n) ->
()
in aux fm ;;
let generate_tier_1 length inf sup =
let rec aux n = match (Random.int 2) with
| 0 -> begin
match n with
| 0 -> Val (1 + Random.int (sup-inf) + inf)
| 1 -> Val (1 + Random.int (sup-inf) + inf)
| k -> Plus (aux (k-1), Val (1 + Random.int (sup-inf) + inf))
end
| 1 -> begin
match n with
| 0 -> Val (1 + Random.int (sup-inf) + inf)
| 1 -> Val (1 + Random.int (sup-inf) + inf)
| k -> Minus (aux (k-1), Val (1 + Random.int (sup-inf) + inf))
end
| _ -> failwith "Never happen"
in aux length ;;
let generate_tier_2 length inf sup mreduction =
let rec aux n = match (Random.int 3) with
| 0 -> begin
match n with
| 0 -> Val (1 + Random.int (sup-inf) + inf)
| 1 -> Val (1 + Random.int (sup-inf) + inf)
| k -> Plus (aux (k-1), Val (1 + Random.int (sup-inf) + inf))
end
| 1 -> begin
match n with
| 0 -> Val (1 + Random.int (sup-inf) + inf)
| 1 -> Val (1 + Random.int (sup-inf) + inf)
| k -> Minus (aux (k-1), Val (1 + Random.int (sup-inf) + inf))
end
| 2 -> begin
match n with
| 0 -> Val (1 + Random.int (sup-inf) + inf)
| 1 -> Val (1 + Random.int (sup-inf) + inf)
| k -> Plus (Multiply (Val ((1 + Random.int (sup-inf) + inf)/mreduction), Val ((1 + Random.int (sup-inf) + inf)/mreduction)), aux (k-2))
end
| _ -> failwith "Never happen"
in aux length ;;
let rec pw x n = match n with
| 0 -> 1
| 1 -> x
| k when k mod 2 = 0 -> let res = pw x (n/2) in res*res
| k -> let res = pw x (n/2) in res*res*x ;;
(* Boi *)
let rec eval_exp fm = match fm with
| Plus (a, b) -> Plus (eval_exp a, eval_exp b)
| Minus (a, b) -> Minus (eval_exp a, eval_exp b)
| Multiply (a, b) -> Multiply (eval_exp a, eval_exp b)
| Val x -> Val x
| Exp (a, n) -> Val (pw (evaluate a) n)
and eval_mult fm = match fm with
| Plus (a, b) -> Plus (eval_mult a, eval_mult b)
| Minus (a, b) -> Minus (eval_mult a, eval_mult b)
| Val x -> Val x
| Exp (a, n) -> Exp(eval_mult a, n)
| Multiply (a, b) -> Val ((evaluate a) * (evaluate b))
and eval_plus fm = match fm with
| Val x -> x
| Plus (a, b) -> (evaluate a) + (evaluate b)
| Minus (a, b) -> (evaluate a) - (evaluate b)
| Exp (a, n) -> failwith "_Impossible"
| Multiply (a, b) -> failwith "Impossible_"
and evaluate fm =
eval_plus (eval_mult (eval_exp fm)) ;;
(* Core functions *)
let update_char code buf = match code with
| k when k >= 48 && k <= 57 ->
(* Integer *)
if !buf >= 0 then begin
buf := !buf * 10;
buf := !buf + code - 48;
end
else begin
buf := !buf * (-1);
buf := !buf * 10;
buf := !buf + code - 48;
buf := !buf * (-1);
end;
true
| 45 ->
(* Minus sign *)
buf := !buf * (-1); true
| 127 ->
(* Delete *)
if !buf >= 0 then begin
buf := !buf / 10
end
else begin
buf := !buf * (-1);
buf := !buf / 10;
buf := !buf * (-1);
end;
true
| 10 ->
(* Enter *)
let math = (generate_tier_2 6 1 100 5) in
print_math math 10 900 15;
buf := evaluate math;
draw_integer 300 300 !buf 20;
Unix.sleepf 15.0;
true
| _ ->
false ;;
(* Main *)
let main () =
open_graph " 1000x1000";
set_window_title "Math";
let buffer = ref 0 in
try
while true do
let ch = get1char () in
let chint = Char.code ch in
if update_char chint buffer then begin
open_graph " 1000x1000";
set_window_title "Math";
draw_integer 300 300 !buffer 20;
end;
Unix.sleepf 0.025
done;
with
| exn -> close_graph (); raise exn ;;
main () ;;
(* ocamlfind ocamlc -linkpkg -package unix -linkpkg -package graphics main.ml *)