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 *)