(*-------------------------------------------------------------------------------------------*)
(* 1 : TYPES *)
(*-------------------------------------------------------------------------------------------*)

type mouvement1 =
	{mutable mv1: (int vect * int vect vect) list}
;;

type context =
	{mutable matrice: int vect vect}
;;

type ops = OPS of (unit -> unit) * (unit -> unit) * (unit -> unit);;

type couleur = ORANGE | VERT | BLANC | ROUGE | BLEU | JAUNE | GRIS;;

type bouton = {titre: string;
		orx: int; ory: int;
		largeur: int; hauteur: int;
		mutable couleur: couleur;
		mutable action: unit -> unit};;

(* type hybride pour saisir un mouvement *)
type info = {mutable videG: bool; mutable videD: bool; mutable ct: int vect; mutable mat: int vect vect};;

type cube1 =
	{
		mutable mouvement1: mouvement1;
		mutable context1: context;
		mutable dessine1: unit -> unit;
		(*mutable liste_mouvements: bool;*)
		mutable rotations_cube1: ops * ops;
		mutable rotations_faces1: ops * ops * ops * ops;
		(*mutable liste_ops1: string list ref;*)
		(*mutable boutons1: bouton vect;
		mutable boutons11: bouton vect*)
	}
;;

(*-------------------------------------------------------------------------------------------*)
(* 2 : DIVERS *)
(*-------------------------------------------------------------------------------------------*)

(* matrices en dimension 3 *)

let matrice_nulle = [|[|0; 0; 0|]; [|0; 0; 0|]; [|0; 0; 0|]|];;

let vect v = if vect_length v = 3 then (v.(0), v.(1), v.(2))
	else failwith "vect"
;;

let identity a = let m = make_matrix 3 3 0 in
		for i = 0 to 2 do
			m.(i).(i) <- a
		done;
		m
;;

let id = identity 1 and idm = identity (- 1);;

(* produit du vecteur ligne entier v par la matrice entière m *)
let prefix /:/ v m =
	let w j = let t = ref 0 in for k = 0 to vect_length v - 1 do
				t := !t + m.(k).(j) * v.(k) done;
			!t in
		[|w 0; w 1; w 2|]
;;

(* produit du scalaire a par la matrice m *)
let prefix /../ a m =
	map_vect (fun x -> map_vect (fun t -> a * t) x) m;;

(* produit matriciel *)
let prefix /./ m m1 = map_vect (fun v -> v /:/ m1) m;;

(* somme matricielle *)
let prefix /+/ m1 m2 =
	let m = make_matrix 3 3 0 in
		for i = 0 to 2 do
			for j = 0 to 2 do
				m.(i).(j) <- m1.(i).(j) + m2.(i).(j)
			done;
		done;
		m
;;

(* produit de la colonne v par la ligne w *)
let prefix /::/ v w =
	let m = make_matrix 3 3 0 in
		for i = 0 to 2 do
			for j = 0 to 2 do
				m.(i).(j) <- v.(i) * w.(j)
			done;
		done;
		m
;;

(* matrice diagonale *)
let diag a b c = [|[|a; 0; 0|]; [|0; b; 0|]; [|0; 0; c|]|];;

(* transposée de la matrice m  qui en est aussi l'inverse : *)
(* quand m est orthogonale *)
let transpose m =
	let m1 = make_matrix 3 3 0 in
		for i = 0 to 2 do
			for j = 0 to 2 do
				m1.(j).(i) <- m.(i).(j)
			done;
		done;
		m1
;;

(* produit scalaire *)
let prefix /|/ v w = v.(0) * w.(0) + v.(1) * w.(1) + v.(2) * w.(2);;

(* matrices des rotations d'un quart de tour autour des axes : *)
(* (opèrent à droite sur les lignes) *)

(* sens des aiguilles d'une montre *)
let rot v = match list_of_vect v with
		| [1; 0; 0] -> [|[|1; 0; 0|]; [|0; 0; - 1|]; [|0; 1; 0|]|]
		| [0; 1; 0] -> [|[|0; 0; 1|]; [|0; 1; 0|]; [|- 1; 0; 0|]|]
		| [0; 0; 1] -> [|[|0; - 1; 0|]; [|1; 0; 0|]; [|0; 0; 1|]|]
		| [- 1; 0; 0] -> [|[|1; 0; 0|]; [|0; 0; 1|]; [|0; - 1; 0|]|]
		| [0; - 1; 0] -> [|[|0; 0; - 1|]; [|0; 1; 0|]; [|1; 0; 0|]|]
		| [0; 0; - 1] -> [|[|0; 1; 0|]; [|- 1; 0; 0|]; [|0; 0; 1|]|]
		| _ -> failwith "rot"
;;

(* sens inverse des aiguilles d'une montre *)
let rot' v = match list_of_vect v with
		| [1; 0; 0] -> [|[|1; 0; 0|]; [|0; 0; 1|]; [|0; - 1; 0|]|]
		| [0; 1; 0] -> [|[|0; 0; - 1|]; [|0; 1; 0|]; [|1; 0; 0|]|]
		| [0; 0; 1] -> [|[|0; 1; 0|]; [|- 1; 0; 0|]; [|0; 0; 1|]|]
		| [- 1; 0; 0] -> [|[|1; 0; 0|]; [|0; 0; - 1|]; [|0; 1; 0|]|]
		| [0; - 1; 0] -> [|[|0; 0; 1|]; [|0; 1; 0|]; [|- 1; 0; 0|]|]
		| [0; 0; - 1] -> [|[|0; - 1; 0|]; [|1; 0; 0|]; [|0; 0; 1|]|]
		| _ -> failwith "rot'"
;;

(* demi-tour d'un angle 'v' *)
let demi_tour v = (* s'applique aux angles 'v' tels que (v/|/v) = 2 uniquement *)
  v /::/ v /+/ idm
;;

(* liste des entiers de 0  n - 1 *)
let liste n =
	let v = make_vect n 0 in
		for i = 0 to n - 1 do
			v.(i) <- i
		done;
		list_of_vect v
;;

(* permutation aléatoire des éléments d'une liste l *)
let random_list l =
	let n = list_length l and l1 = ref []
	in
		for i = 0 to n - 1 do
			l1 := (vect_of_list (subtract l !l1)).(random__int (n - i)) :: !l1
		done;
		!l1
;;

(* signature de la permutation p des éléments de la liste l *)
let sign l p =
	let n = list_length l and v = vect_of_list l
	and m = ref 1 in
		for i = 0 to n - 1 do
			for j = i + 1 to n - 1 do
				let a = v.(i) and b = v.(j) in
					if p a > p b && b > a || p b > p a && a > b then m := - !m;
			done;
		done;
		!m
;;

(* exécution d'une liste de mouvements *)
let rec exe l = match l with
		t :: r -> t (); exe r;
		| [] -> ()
;;

(* liste dans l'ordre des éléments de l satisfaisant 'critère' *)
let rec select critere l = match l with
		t :: r -> let l1 = select critere r in if critere t then t :: l1 else l1
		| _ -> []
;;

let tete s =
	let l = string_length s in
		if l = 0 then ""
		else if l = 1 then sub_string s 0 1
		else if l = 2 then if s.[1] = `0` || s.[1] = `'` then s else sub_string s 0 1
		else match s.[1], s.[2] with
				| `0`, `'` -> sub_string s 0 3
				| `0`, _ -> sub_string s 0 2
				| `'`, _ -> sub_string s 0 2
				| _ -> sub_string s 0 1
;;

let scinde s =
	let t = tete s and ls = string_length s in
		let lt = string_length t in
			let r = sub_string s lt (ls - lt) in
				(t, r)
;;

let rec op_names_from_string s =
	let (t, r) = scinde s in
		if r = "" then [t] else t :: op_names_from_string r
;;

let format_string op_names_string = "exec \"" ^ op_names_string ^ "\";;\n";;

(* remplacement dans la chaîne 's' des sous-chaînes 'a' par la chaîne 'b' *)
(* dans un parcours de 's' de gauche à droite *) 
let rec remplace s a b =
	let ls = string_length s and la = string_length a in
		if ls < la then s else
		if sub_string s 0 la = a then
			b ^ remplace (sub_string s la (ls - la)) a b
		else sub_string s 0 1 ^ remplace (sub_string s 1 (ls - 1)) a b
;;


(*-------------------------------------------------------------------------------------------*)
(* 3 : INDICES *)
(*-------------------------------------------------------------------------------------------*)

(* indices des angles et des coins et des centres des faces *)
let indices = let l = ref [] in
    for k = 1 downto - 1 do
      for j = 1 downto - 1 do
        for i = 1 downto - 1 do l := [|i; j; k|] :: !l
        done
      done
    done;
    subtract !l [[|0; 0; 0|]]
;;

let est_centre x = x /|/ x = 1;;
let est_angle x = x /|/ x = 2;;
let est_coin x = x /|/ x = 3;;

(* liste des angles *)
let centres = select est_centre indices;;

(* liste des angles *)
let angles = select est_angle indices;;

(* liste des coins *)
let coins = select est_coin indices;;


(*-------------------------------------------------------------------------------------------*)
(* 4 : GROUPE DU CUBE *)
(*-------------------------------------------------------------------------------------------*)

let groupe_du_cube =
	[
		[|[|1; 0; 0|]; [|0; 1; 0|]; [|0; 0; 1|]|];
		[|[|1; 0; 0|]; [|0; - 1; 0|]; [|0; 0; - 1|]|];
		[|[|- 1; 0; 0|]; [|0; 1; 0|]; [|0; 0; - 1|]|];
		[|[|- 1; 0; 0|]; [|0; - 1; 0|]; [|0; 0; 1|]|];
		[|[|1; 0; 0|]; [|0; 0; - 1|]; [|0; 1; 0|]|];
		[|[|0; 0; 1|]; [|0; 1; 0|]; [|- 1; 0; 0|]|];
		[|[|0; - 1; 0|]; [|1; 0; 0|]; [|0; 0; 1|]|];
		[|[|1; 0; 0|]; [|0; 0; 1|]; [|0; - 1; 0|]|];
		[|[|0; 0; - 1|]; [|0; 1; 0|]; [|1; 0; 0|]|];
		[|[|0; 1; 0|]; [|- 1; 0; 0|]; [|0; 0; 1|]|];
		[|[|0; - 1; 0|]; [|- 1; 0; 0|]; [|0; 0; - 1|]|];
		[|[|0; 1; 0|]; [|1; 0; 0|]; [|0; 0; - 1|]|];
		[|[|- 1; 0; 0|]; [|0; 0; - 1|]; [|0; - 1; 0|]|];
		[|[|0; 0; - 1|]; [|0; - 1; 0|]; [|- 1; 0; 0|]|];
		[|[|0; 0; 1|]; [|0; - 1; 0|]; [|1; 0; 0|]|];
		[|[|- 1; 0; 0|]; [|0; 0; 1|]; [|0; 1; 0|]|];
		[|[|0; 1; 0|]; [|0; 0; 1|]; [|1; 0; 0|]|];
		[|[|0; 0; - 1|]; [|- 1; 0; 0|]; [|0; 1; 0|]|];
		[|[|0; 0; 1|]; [|- 1; 0; 0|]; [|0; - 1; 0|]|];
		[|[|0; 1; 0|]; [|0; 0; - 1|]; [|- 1; 0; 0|]|];
		[|[|0; 0; - 1|]; [|1; 0; 0|]; [|0; - 1; 0|]|];
		[|[|0; - 1; 0|]; [|0; 0; - 1|]; [|1; 0; 0|]|];
		[|[|0; - 1; 0|]; [|0; 0; 1|]; [|- 1; 0; 0|]|];
		[|[|0; 0; 1|]; [|1; 0; 0|]; [|0; 1; 0|]|]
	]
;;


(*-------------------------------------------------------------------------------------------*)
(* 5 : GROUPE DES MOUVEMENTS *)
(*-------------------------------------------------------------------------------------------*)

(* groupe M des mouvements des minicubes *)

(* tri d'un mouvement selon l'ordre des indices *)
let trier mv1 = sort__sort (fun x y -> fst x < fst y) mv1;;

(* élément neutre de M *)
let e = map (fun x -> x, id) indices;;

(* conversion entre mouvement représenté par une fonction et mouvement *)
(* représenté par une liste : (int vect * int vect vect) list *)
let mv1_of_fun f =
	map (fun (x, y) -> (x, y /./ (f x))) e
;;
let fun_of_mv1 mv1 x =
	assoc x mv1
;;

(* mouvements globaux *)
let cst x = mv1_of_fun (fun t -> x);;

(* loi interne *)
let prefix /*/ mv1 mv1' =
	let f = fun_of_mv1 mv1 and f' = fun_of_mv1 mv1'
	in
		let s t = t /:/ (f t)
		in trier (mv1_of_fun (fun x -> (f x) /./ (f' (s x))))
;;

(* inverse d'un élément *)
let inverse mv1 = map (fun (x, y) -> (x /:/ y, transpose y)) mv1;;

(* mouvements de Rubik élémentaires *)

(* rotations dans le sens des aiguilles d'une montre d'un quart de tour de la *)
(* face - tranche interne dans le cas du cube 4x4 - normale au vecteur sortant 'v' *)
let rub v = mv1_of_fun
	(fun x -> if (x /|/ v) = 1 then rot v else id)
;;

(* mouvement inverse du précédent *)
let rub' v = inverse (rub v);;

(* enregistrement sur disque d'un mouvement *)
let enregistrer mouvement file =
	let chan_out = open_out_bin file in
		output_value chan_out mouvement;
		close_out chan_out
;;

(* lecture sur disque d'un mouvement *)
let lire_mouvement file =
	try
		let chan_in = open_in_bin file
		in
			let mv1_saved =
				input_value chan_in
			in
				close_in chan_in;
				mv1_saved
	with sys__Sys_error s -> failwith s
;;

(* lecture sur disque d'un mouvement : format portable *)
let couple_of_int_matrice s =
	let t = make_matrix 4 3 0 in
		for i = 0 to 3 do
			for j = 0 to 2 do
				t.(i).(j) <- s.(i * 3 + j)
			done
		done;
		(t.(0), [|t.(1); t.(2); t.(3)|])
;;
let int_vect s =
	let tete s =
		let l = string_length s in
			if l = 0 then ""
			else if s.[0] = `-` then sub_string s 0 2
			else sub_string s 0 1
	in
		let reste s =
			let l = string_length s
			and lt = string_length (tete s) in
				sub_string s lt (l - lt)
		in
			if s = "" then [||]
			else
				let rec aux ss =
					let t = tete ss and r = reste ss in
						if r <> "" then t :: aux r
						else [t]
				in vect_of_list (map int_of_string (aux s))
;;
let int_matrices_of_int_vect v =
	let lst = ref [] in
		for i = 0 to (vect_length v - 12) / 12 do
			lst := sub_vect v (12 * i) 12 :: !lst
		done;
		vect_of_list !lst
;;
let lire_mouv path =
			try
				let canalin = open_in path in
					let s = input_line canalin in
					close_in canalin;
					rev (list_of_vect (map_vect couple_of_int_matrice (int_matrices_of_int_vect (int_vect s))))
			with sys__Sys_error s1 -> print_string s1; e
;;

(*-------------------------------------------------------------------------------------------*)
(* 7 : COULEURS *)
(*-------------------------------------------------------------------------------------------*)

(* couleur rvb de la  couleur c *)
let couleur_rvb_de_couleur c =
	match c with
		| ROUGE -> graphics__red (*rouge*)
		| ORANGE -> graphics__rgb 255 165 0 (* orange *)
		| BLEU -> graphics__rgb 0 150 225 (* bleu *)
		| VERT -> graphics__green (*vert *)
		| JAUNE -> graphics__yellow (*jaune *)
		| BLANC -> graphics__white (* blanc *)
		| GRIS -> graphics__rgb 100 100 100
;;

(* association entre couleurs et vecteurs normaux aux faces du cube *)
let couleur_de_face v =
	match vect v with
		| 1, 0, 0 -> ORANGE
		| - 1, 0, 0 -> ROUGE
		| 0, 1, 0 -> VERT
		| 0, - 1, 0 -> BLEU
		| 0, 0, 1 -> BLANC
		| 0, 0, - 1 -> JAUNE
		| _ -> GRIS
;;

let couleur_rvb_de_face v =
	couleur_rvb_de_couleur (couleur_de_face v)
;;

let nom_couleur_de_face v=
	match vect v with
		| 1, 0, 0 -> "orange"
		| - 1, 0, 0 -> "rouge"
		| 0, 1, 0 -> "vert"
		| 0, - 1, 0 -> "bleu"
		| 0, 0, 1 -> "blanc"
		| 0, 0, - 1 -> "jaune"
		| _ -> "?"
;;

let nom_de_couleur couleur =
	match couleur with
		| ORANGE -> "ORANGE"
		| ROUGE -> "ROUGE"
		| VERT -> "VERT"
		| BLEU -> "BLEU"
		| BLANC -> "BLANC"
		| JAUNE -> "JAUNE"
		| _ -> "GRIS"
;;


(*-------------------------------------------------------------------------------------------*)
(* 8 : GRAPHISME *)
(*-------------------------------------------------------------------------------------------*)

let proj x y z =
  let c = sqrt 6. /. 2. in
    (c *. (y -. x) /. sqrt 2., c *. (-. (x +. y) +. 2. *. z) /. sqrt 6.)
;;

let xx ox oy ux uy v pt3 =
  let (x, y, z) = vect (map_vect float_of_int pt3) in
    let (x1, y1, z1) =
      if v /|/ [|1; 1; 1|] = 1 then (x, y, z)
      else match vect v with
          | (_, 0, 0) -> (x -. 7., y, z)
          | (0, _, 0) -> (x, y -. 7., z)
          | _ -> (x, y, z -. 7.)
    in
      int_of_float (float_of_int ox +. fst (proj x1 y1 z1) *. float_of_int ux)
;;

let yy ox oy ux uy v pt3 =
  let (x, y, z) = vect (map_vect float_of_int pt3) in
    let (x1, y1, z1) =
      if v /|/ [|1; 1; 1|] = 1 then (x, y, z)
      else match vect v with
          | (_, 0, 0) -> (x -. 7., y, z)
          | (0, _, 0) -> (x, y -. 7., z)
          | _ -> (x, y, z -. 7.)
    in
      int_of_float (float_of_int oy +. snd (proj x1 y1 z1) *. float_of_int uy)
;;

(* la fonction 'drawPoly' est utilisée pour tracer le pourtour des projections *)
(* des faces des minicubes *)
let drawPoly poly =
  let (x, y) = poly.(0) in graphics__moveto x y;
    for i = 1 to vect_length poly - 1 do
      let (x, y) = poly.(i) in graphics__lineto x y
    done;
    let (x, y) = poly.(0) in graphics__lineto x y;
;;

(* la fonction 'draw' est utilisée pour dessiner la projection 'x' d'une face *)
(* de minicube en superposant le tracé du pourtour à la couleur de remplissage *)
let draw x =
  let a, b = x in
    graphics__set_color b;
    graphics__fill_poly a;
    graphics__set_color graphics__black;
    drawPoly a
;;

(* 'face v c' renvoie, si le minicube à l'emplacement d'indice 'c' a une face F *)
(* dans la face du Rubik's cube normale au vecteur sortant 'v', sous forme de vecteur *)
(* une liste des 4 sommets de F correspondant à un parcours de son bord *)

let coeff = ref 2;;

let face v c =
  let e = v /|/ [|1; 1; 1|] in let w = [|e; e; e|] in
      let w1 = w /:/ rot v in
        let w2 = w1 /:/ rot v in
          let w3 = w2 /:/ rot v in
            let l = [w; w1; w2; w3] in
              let add m = for i = 0 to 2 do m.(i) <- m.(i) + !coeff * c.(i) done
              in
                do_list add l;
                vect_of_list l;
;;

(* 'faces' renvoie une liste de triplets : la première composante est un centre 'c', la deuxième composante *)
(* est un vecteur listant les 3 vecteurs unitaires sortants normaux aux faces visibles du minicube centré en 'c' *)
(* et la troisième est un vecteur dont la composante numéro i est un vecteur listant les 4 sommets de la face visible *)
(* normale au vecteur numéro i précédent : i = 0,1,2 pour un coin, i = 0,1 pour un angle, i = 0 pour un centre *)

let faces c =
  let d = vect_of_list (subtract (list_of_vect (diag c.(0) c.(1) c.(2))) [[|0; 0; 0|]]) in
    c, d, map_vect (fun v -> face v c) d
;;


(* affichage du cube 3x3, avec repères des centres, dans l'état mv : repère ADH *)
let affiche ox oy ux uy mat context centre =
  let p = context.matrice in
    let _, d, f = faces centre in
      for i = 0 to vect_length d - 1 do
        let v = d.(i) /:/ mat in
          let g = map_vect (fun x -> x /:/ mat) f.(i) in
            draw ((map_vect (fun pt -> (xx ox oy ux uy (v /:/ p) (pt /:/ p), yy ox oy ux uy (v /:/ p) (pt /:/ p)))
                g),
              couleur_rvb_de_face d.(i));
            if est_centre centre then
            (* pour le tracé des rayons des centres des faces de bords f *)
              let mil p =
                let aux v w = [|(v.(0) + w.(0)) / 2; (v.(1) + w.(1)) / 2; (v.(2) + w.(2)) / 2|] in
                  aux p.(0) p.(2)
              in
                let m = mil f.(i)
                in
                  let (c1, c2) = (xx ox oy ux uy (d.(i) /:/ p) (m /:/ p), yy ox oy ux uy (d.(i) /:/ p) (m /:/ p)) in
                    graphics__set_color graphics__black;
                    graphics__moveto c1 c2;
                    graphics__lineto (xx ox oy ux uy (v /:/ p) (g.(0) /:/ p)) (yy ox oy ux uy (v /:/ p) (g.(0) /:/ p))
      done
;;

let affiche_mouvement ox oy ux uy context mv =
  do_list (fun x -> affiche ox oy ux uy (fun_of_mv1 mv x) context x) indices
;;

let affiche1_mouvement ox oy ux uy mv =
  affiche_mouvement ox oy ux uy {matrice = id} mv
;;

let affiche1 ox oy ux uy mat context centre =
	let p = context.matrice in
		let _, d, f = faces centre in
			for i = 0 to vect_length d - 1 do
				let v = d.(i) /:/ mat in
					let g = map_vect (fun x -> x /:/ mat) f.(i) in
						draw ((map_vect (fun pt -> (xx ox oy ux uy v pt, yy ox oy ux uy v pt))
								g),
							couleur_rvb_de_face (d.(i)/:/transpose p));
			done
;;

(* affichage en gris d'un minicube *)
let griser ox oy ux uy centre =
  let c, d, f = faces centre in
    for i = 0 to vect_length d - 1 do
      let v = d.(i) in
        draw ((map_vect (fun pt -> (xx ox oy ux uy v pt, yy ox oy ux uy v pt))
            f.(i)),
          couleur_rvb_de_couleur GRIS)
    done
;;

(* affichage du cube en gris *)
let tout_griser context ox oy ux uy =
  affiche_mouvement ox oy ux uy context e;
  do_list (griser ox oy ux uy) (select (fun x -> not est_centre x) indices)
;;

(* Fenêtre de largeur 612 et hauteur 612 : origine  au centre (306,306), units : 20,20 *)
let dessine_cube context mv1 = affiche_mouvement 306 306 20 20 context mv1;;

(*-------------------------------------------------------------------------------------------*)
(* 12 : RÉSOLUTION DU CUBE 3x3 par niveaux : "supérieur, médian, inférieur" *)
(*-------------------------------------------------------------------------------------------*)

(* en repère adh, la matrice de passage dans le groupe du cube telle que dans le repère adh associé *)
(* le coin centré en x dans l'état mv ait les couleurs adh coul1, coul2, coul3 *)
let context_adh_aux (coul1, coul2, coul3) mv xx =
	let couleurs_adh context mouvement x =
		let eclate x = [|[|x.(0); 0; 0|]; [|0; x.(1); 0|]; [|0; 0; x.(2)|]|] in
			let p = context.matrice in
				let m = eclate x /./ transpose p /./ (fun_of_mv1 (inverse mouvement)) (x /:/ transpose p) in
					map_vect couleur_de_face m
	in
		{matrice = hd (select (fun p -> couleurs_adh {matrice = p} mv xx = [|coul1; coul2; coul3|]) groupe_du_cube)}
;;

let context_adh (coul1, coul2, coul3) mv = context_adh_aux (coul1, coul2, coul3) mv [|1;1;1|];;

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

let nouveau_cube mouvement context dessine_cube liste_mouvements =
	let dessine () = dessine_cube context mouvement.mv1
	and matr = context.matrice
	in
		let rotations_faces () =
			let fct x () =
				let t = x /:/ transpose context.matrice in
					mouvement.mv1 <- mouvement.mv1 /*/ rub t;
					dessine ()
			and fct' x () =
				let t = x /:/ transpose context.matrice in
					mouvement.mv1 <- mouvement.mv1 /*/ rub' t;
					dessine ()
			in
				let (a, d, h) = vect (map_vect fct id)
				and (a', d', h') = vect (map_vect fct' id)
				and (p, g, b) = vect (map_vect fct idm)
				and (p', g', b') = vect (map_vect fct' idm)
				in (OPS (a, d, h), OPS (a', d', h'), OPS (p, g, b), OPS (p', g', b'))
		and rotations_cube () =
			let rotate pp () = context.matrice <- context.matrice /./ pp;
				dessine ()
			in
				let (a, d, h) = vect (map_vect rotate (map_vect rot id))
				and (a', d', h') = vect (map_vect rotate (map_vect rot' id))
				in
					(OPS (a, d, h), OPS (a', d', h'))		
		in
			{
				mouvement1 = mouvement;
				context1 = context; dessine1 = dessine;
				rotations_cube1 = rotations_cube ();
				rotations_faces1 = rotations_faces ();
			}
;;

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

let cube = nouveau_cube {mv1 = e} {matrice = id} dessine_cube true;;

let (OPS (a, d, h), OPS (a', d', h'), OPS (p, g, b), OPS (p', g', b')) = cube.rotations_faces1
and (OPS (a0, d0, h0), OPS (a0', d0', h0')) = cube.rotations_cube1;;

let op_with_name s =
	let la = [("a", a); ("p", p); ("h", h); ("b", b); ("d", d); ("g", g);
			("a'", a'); ("p'", p'); ("h'", h'); ("b'", b'); ("d'", d'); ("g'", g');
			("a0", a0); ("d0", d0); ("h0", h0); ("a0'", a0'); ("d0'", d0'); ("h0'", h0')]
	in
		assoc s la;;

let exec s = exe (map op_with_name (op_names_from_string s));;


