Portage vers raylib-ocaml

diff --git a/README.txt b/README.txt
index a1e370da2aa0037f219e7b33599b13af213bd86d..20fc48fb98023e4bdaa9c974027bbadc8a5a5673 100644 (file)
--- a/README.txt
+++ b/README.txt
@@ -1,6 +1,6 @@
 Dépendances:
        OCaml
 Dépendances:
        OCaml

-       ocaml-graphics
+       raylib-ocaml

 
 Compiler:
        dune b
 
 Compiler:
        dune b

diff --git a/bin/dune b/bin/dune
index a45521e101d850bb03fba0ac3a3b7bfe721873e2..99ab00461355d87ba7bd84b384cdb883e6ee418d 100644 (file)
--- a/bin/dune
+++ b/bin/dune
@@ -1,4 +1,4 @@
 (executable
  (public_name cells)
  (name main)
 (executable
  (public_name cells)
  (name main)

- (libraries automata graphics unix))
+ (libraries automata raylib unix))

diff --git a/bin/main.ml b/bin/main.ml
index 13ded836a31ca0b55b927060ed5f9795fd8219eb..9e60a69f5594ac62d9631f7df1f0479776e24c9d 100644 (file)
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -13,24 +13,49 @@
  * with this program. If not, see <https://www.gnu.org/licenses/>.
  *)
 
  * with this program. If not, see <https://www.gnu.org/licenses/>.
  *)
 

+let string_of_uchar c =
+        let buf = Buffer.create 4 in
+        Buffer.add_utf_8_uchar buf c;
+        Buffer.contents buf
+

 let run (type state initer) (m : (module Modes.Mode with type state = state and type initer = initer)) (init : initer) =
         let rec aux : type state. Modes.editor_state -> (module Modes.Mode with type state = state) -> state -> unit =
                fun estate m state ->
                 let module M = (val m) in
 let run (type state initer) (m : (module Modes.Mode with type state = state and type initer = initer)) (init : initer) =
         let rec aux : type state. Modes.editor_state -> (module Modes.Mode with type state = state) -> state -> unit =
                fun estate m state ->
                 let module M = (val m) in

+                Raylib.begin_drawing ();

                 M.render estate state;
                 M.render estate state;

-                Graphics.synchronize ();
-                if Graphics.key_pressed ()
-                then
-                  match M.update estate state (Graphics.read_key ()) with
-                  | estate, Either.Left state -> aux estate m state
-                  | estate, Either.Right (ModeAndState (m, state)) -> aux estate m state
-                else aux estate m state
+                Raylib.end_drawing ();
+                if Modes.should_close estate || Raylib.window_should_close ()
+                then Raylib.close_window ()
+                else
+                  let handle_key () =
+                          match Raylib.get_key_pressed () with
+                          | Raylib.Key.Null -> aux estate m state
+                          | k -> (
+                                  match M.update estate state (Either.right k) with
+                                  | estate, Either.Left state -> aux estate m state
+                                  | estate, Either.Right (ModeAndState (m, state)) -> aux estate m state)
+                  in
+                  match Raylib.get_char_pressed () with
+                  | c when c = Uchar.min -> handle_key ()
+                  | c ->
+                          let estate, ModeAndState (m, state) =
+                                  String.fold_left
+                                    (fun (estate, Modes.ModeAux.ModeAndState (m, state)) c ->
+                                      let module M = (val m) in
+                                      match M.update estate state (Either.left c) with
+                                      | estate, Either.Left state -> (estate, ModeAndState (m, state))
+                                      | estate, Either.Right ms -> (estate, ms))
+                                    (estate, ModeAndState (m, state))
+                                    (string_of_uchar c)
+                          in
+                          aux estate m state

         in
         let module M = (val m) in
         aux Modes.default_state (module M) (M.initial init)
 
 let () =
         in
         let module M = (val m) in
         aux Modes.default_state (module M) (M.initial init)
 
 let () =

-        Graphics.open_graph "";
-        Graphics.set_window_title "Automaton";
-        Graphics.auto_synchronize false;
-        try run (module Modes.Normal) () with Graphics.Graphic_failure _ -> ()
+        Raylib.init_window 750 750 "Automates !";
+        Raylib.set_exit_key Raylib.Key.Null;
+        Raylib.set_target_fps 60;
+        run (module Modes.Normal) ()

diff --git a/bin/modes.ml b/bin/modes.ml
index e7643dd75697a6f84c43b55a6206dbba57748332..016e0f1df7418570bb530ab4a203747a81dee1f0 100644 (file)
--- a/bin/modes.ml
+++ b/bin/modes.ml
@@ -13,7 +13,7 @@
  * with this program. If not, see <https://www.gnu.org/licenses/>.
  *)
 
  * with this program. If not, see <https://www.gnu.org/licenses/>.
  *)
 

-type 'c editor_state_aux = { board: 'c Automata.board; pos: int * int; size: int }
+type 'c editor_state_aux = { board: 'c Automata.board; pos: int * int; size: int; should_close: bool }

 
 type editor_state = EditorState : (module Automata.Automaton with type t = 'c) * 'c editor_state_aux -> editor_state
 
 
 type editor_state = EditorState : (module Automata.Automaton with type t = 'c) * 'c editor_state_aux -> editor_state
 


@@ -21,9 +21,13 @@ let default_state =
         match Automata.automata with
         | auto :: _ ->
                 let module Auto = (val auto) in
         match Automata.automata with
         | auto :: _ ->
                 let module Auto = (val auto) in

-                EditorState ((module Auto), { board = Automata.initial (module Auto); pos = (0, 0); size = 16 })
+                EditorState
+                  ( (module Auto),
+                    { board = Automata.initial (module Auto); pos = (0, 0); size = 16; should_close = false } )

         | [] -> assert false
 
         | [] -> assert false
 

+let should_close (EditorState (_, { should_close; _ })) = should_close
+

 module rec ModeAux : sig
   type mode_and_state = ModeAndState : (module ModeAux.S with type state = 'a) * 'a -> mode_and_state
 
 module rec ModeAux : sig
   type mode_and_state = ModeAndState : (module ModeAux.S with type state = 'a) * 'a -> mode_and_state
 


@@ -36,7 +40,8 @@ module rec ModeAux : sig
 
     val render : editor_state -> state -> unit
 
 
     val render : editor_state -> state -> unit
 

-    val update : editor_state -> state -> char -> editor_state * (state, mode_and_state) Either.t
+    val update :
+      editor_state -> state -> (char, Raylib.Key.t) Either.t -> editor_state * (state, mode_and_state) Either.t

   end
 end =
   ModeAux
   end
 end =
   ModeAux


@@ -47,10 +52,10 @@ let get_name (m : (module Automata.Automaton)) =
         let module M = (val m) in
         M.name
 
         let module M = (val m) in
         M.name
 

-let render_world (EditorState (m, { board; pos = px, py; size })) =
+let render_world (EditorState (m, { board; pos = px, py; size; _ })) =

         let module M = (val m) in
         let module M = (val m) in

-        let sx = Graphics.size_x ()
-        and sy = Graphics.size_y () in
+        let sx = Raylib.get_screen_width ()
+        and sy = Raylib.get_screen_height () in

         let w = (sx / size) + 1
         and h = (sy / size) + 1 in
         let wx = px - (w / 2)
         let w = (sx / size) + 1
         and h = (sy / size) + 1 in
         let wx = px - (w / 2)


@@ -59,21 +64,23 @@ let render_world (EditorState (m, { board; pos = px, py; size })) =
           (fun x y c ->
             let r, g, b = M.color c in
             let r, g, b = (int_of_char r, int_of_char g, int_of_char b) in
           (fun x y c ->
             let r, g, b = M.color c in
             let r, g, b = (int_of_char r, int_of_char g, int_of_char b) in

-            Graphics.set_color (Graphics.rgb r g b);
-            Graphics.fill_rect ((x - wx) * size) ((y - wy) * size) size size)
+            let c = Raylib.Color.create r g b 255 in
+            Raylib.draw_rectangle ((x - wx) * size) ((y - wy) * size) size size c)

           board;
           board;

-        Graphics.set_color (Graphics.rgb 127 127 127);
+        let c = Raylib.Color.create 127 127 127 255 in

         for x = 0 to w do
         for x = 0 to w do

-          Graphics.moveto (x * size) 0;
-          Graphics.lineto (x * size) sy
+          Raylib.draw_line (x * size) 0 (x * size) sy c

         done;
         for y = 0 to h do
         done;
         for y = 0 to h do

-          Graphics.moveto 0 (y * size);
-          Graphics.lineto sx (y * size)
+          Raylib.draw_line 0 (y * size) sx (y * size) c

         done;
         done;

-        Graphics.set_line_width ((size / 25) + 2);
-        Graphics.draw_rect ((px - wx) * size) ((py - wy) * size) size size;
-        Graphics.set_line_width 1
+        Raylib.draw_rectangle_lines_ex
+          (Raylib.Rectangle.create
+             (float_of_int ((px - wx) * size))
+             (float_of_int ((py - wy) * size))
+             (float_of_int size) (float_of_int size))
+          ((float_of_int size /. 25.) +. 2.)
+          c

 
 module rec Command : (Mode with type initer = string) = struct
   type state = string * string list
 
 module rec Command : (Mode with type initer = string) = struct
   type state = string * string list


@@ -83,19 +90,17 @@ module rec Command : (Mode with type initer = string) = struct
   let initial s = (s, [])
 
   let render st (cmd, sug) =
   let initial s = (s, [])
 
   let render st (cmd, sug) =

+          let sx = Raylib.get_screen_width () in
+          let sy = Raylib.get_screen_height () in

           render_world st;
           render_world st;

-          Graphics.set_color Graphics.white;
-          Graphics.fill_rect 0 0 (Graphics.size_x ()) 25;
-          Graphics.set_color Graphics.black;
-          Graphics.moveto 10 8;
-          Graphics.draw_string (":" ^ cmd);
+          Raylib.draw_rectangle 0 (sy - 25) sx 25 Raylib.Color.white;
+          Raylib.draw_text (":" ^ cmd) 10 (sy - 22) 20 Raylib.Color.black;
+          let x = 10 + Raylib.measure_text (":" ^ cmd) 20 in
+          Raylib.draw_line x (sy - 20) x (sy - 5) (Raylib.Color.create 127 127 127 255);

           List.iteri
             (fun i s ->
           List.iteri
             (fun i s ->

-              Graphics.set_color Graphics.white;
-              Graphics.fill_rect 50 ((25 * i) + 25) (Graphics.size_x ()) 25;
-              Graphics.set_color Graphics.black;
-              Graphics.moveto 60 ((25 * i) + 25 + 8);
-              Graphics.draw_string s)
+              Raylib.draw_rectangle 50 (sy - (25 * i) - 55) sx 25 Raylib.Color.white;
+              Raylib.draw_text s 60 (sy - (25 * i) - 52) 20 Raylib.Color.black)

             sug
 
   let rec last = function
             sug
 
   let rec last = function


@@ -165,9 +170,7 @@ module rec Command : (Mode with type initer = string) = struct
           let module M = (val m) in
           try
             match Parse.shlex cmd with
           let module M = (val m) in
           try
             match Parse.shlex cmd with

-            | ["quit"] ->
-                    Graphics.close_graph ();
-                    (estate, Either.left ("", []))
+            | ["quit"] -> (EditorState (m, { st with should_close = true }), Either.left ("", []))

             | ["clear"] ->
                     ( EditorState ((module M), { st with board = Automata.initial (module M); pos = (0, 0) }),
                       Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())) )
             | ["clear"] ->
                     ( EditorState ((module M), { st with board = Automata.initial (module M); pos = (0, 0) }),
                       Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())) )


@@ -175,7 +178,8 @@ module rec Command : (Mode with type initer = string) = struct
                     match List.find_opt (fun m -> get_name m = auto) Automata.automata with
                     | Some auto ->
                             let module M = (val auto) in
                     match List.find_opt (fun m -> get_name m = auto) Automata.automata with
                     | Some auto ->
                             let module M = (val auto) in

-                            ( EditorState ((module M), { board = Automata.initial (module M); pos = (0, 0); size = 16 }),
+                            ( EditorState
+                                ((module M), { st with board = Automata.initial (module M); pos = (0, 0); size = 16 }),

                               Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())) )
                     | None ->
                             Printf.fprintf stderr "Automate inconnu: `%s' !\n%!" auto;
                               Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())) )
                     | None ->
                             Printf.fprintf stderr "Automate inconnu: `%s' !\n%!" auto;


@@ -194,7 +198,8 @@ module rec Command : (Mode with type initer = string) = struct
                           let auto = List.find (fun m -> get_name m = name) Automata.automata in
                           let module M = (val auto) in
                           ( EditorState
                           let auto = List.find (fun m -> get_name m = name) Automata.automata in
                           let module M = (val auto) in
                           ( EditorState

-                              ((module M), { board = Automata.deserialise (module M) f; pos = st.pos; size = st.size }),
+                              ( (module M),
+                                { st with board = Automata.deserialise (module M) f; pos = st.pos; size = st.size } ),

                             Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())) ))
                     with Sys_error _ ->
                       Printf.fprintf stderr "Failed to write file `%s' !\n%!" f;
                             Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())) ))
                     with Sys_error _ ->
                       Printf.fprintf stderr "Failed to write file `%s' !\n%!" f;


@@ -206,12 +211,15 @@ module rec Command : (Mode with type initer = string) = struct
             Printf.fprintf stderr "Unterminated string !\n%!";
             (estate, Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())))
 
             Printf.fprintf stderr "Unterminated string !\n%!";
             (estate, Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())))
 

-  let update estate (cmd, _) = function
-          | '\b' -> (estate, Either.left (String.sub cmd 0 (max (String.length cmd - 1) 0), []))
-          | '\e' -> (estate, Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())))
-          | '\r' -> run_cmd estate cmd
-          | '\t' -> (estate, Either.left (autocomplete cmd))
-          | c -> (estate, Either.left (cmd ^ String.make 1 c, []))
+  let update estate ((cmd, _) as st) = function
+          | Either.Right Raylib.Key.Backspace ->
+                  (estate, Either.left (String.sub cmd 0 (max (String.length cmd - 1) 0), []))
+          | Either.Right Raylib.Key.Escape ->
+                  (estate, Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())))
+          | Either.Right Raylib.Key.Enter -> run_cmd estate cmd
+          | Either.Right Raylib.Key.Tab -> (estate, Either.left (autocomplete cmd))
+          | Either.Right _ -> (estate, Either.left st)
+          | Either.Left c -> (estate, Either.left (cmd ^ String.make 1 c, []))

 end
 
 and Normal : (Mode with type initer = unit) = struct
 end
 
 and Normal : (Mode with type initer = unit) = struct


@@ -237,21 +245,23 @@ and Normal : (Mode with type initer = unit) = struct
                   iter_n (Option.value n ~default:1)
           in
           function
                   iter_n (Option.value n ~default:1)
           in
           function

-          | ':' -> (EditorState (m, st), Either.right (ModeAux.ModeAndState ((module Command), Command.initial "")))
-          | '0' when n.n = None -> (EditorState (m, { st with pos = (0, 0) }), Either.left n)
-          | c when '0' <= c && c <= '9' -> (EditorState (m, st), Either.left (chnum (int_of_char c - int_of_char '0') n))
-          | 'f' ->
+          | Either.Left ':' ->
+                  (EditorState (m, st), Either.right (ModeAux.ModeAndState ((module Command), Command.initial "")))
+          | Either.Left '0' when n.n = None -> (EditorState (m, { st with pos = (0, 0) }), Either.left n)
+          | Either.Left c when '0' <= c && c <= '9' ->
+                  (EditorState (m, st), Either.left (chnum (int_of_char c - int_of_char '0') n))
+          | Either.Left 'f' ->

                   ( EditorState (m, ntimes n (fun st -> { st with board = Automata.update (module M) st.board }) st),
                     Either.left { n = None } )
                   ( EditorState (m, ntimes n (fun st -> { st with board = Automata.update (module M) st.board }) st),
                     Either.left { n = None } )

-          | 'i' ->
+          | Either.Left 'i' ->

                   ( EditorState (m, st),
                     Either.right (ModeAux.ModeAndState ((module Insert), Insert.initial (fst st.pos))) )
                   ( EditorState (m, st),
                     Either.right (ModeAux.ModeAndState ((module Insert), Insert.initial (fst st.pos))) )

-          | 'k' -> (EditorState (m, ntimes n (chpos 0 1) st), Either.left { n = None })
-          | 'h' -> (EditorState (m, ntimes n (chpos (-1) 0) st), Either.left { n = None })
-          | 'j' -> (EditorState (m, ntimes n (chpos 0 (-1)) st), Either.left { n = None })
-          | 'l' -> (EditorState (m, ntimes n (chpos 1 0) st), Either.left { n = None })
-          | 'o' -> (EditorState (m, ntimes n (chsize (max 1 (st.size / 10))) st), Either.left { n = None })
-          | 'p' -> (EditorState (m, ntimes n (chsize (-max 1 (st.size / 10))) st), Either.left { n = None })
+          | Either.Left 'k' -> (EditorState (m, ntimes n (chpos 0 (-1)) st), Either.left { n = None })
+          | Either.Left 'h' -> (EditorState (m, ntimes n (chpos (-1) 0) st), Either.left { n = None })
+          | Either.Left 'j' -> (EditorState (m, ntimes n (chpos 0 1) st), Either.left { n = None })
+          | Either.Left 'l' -> (EditorState (m, ntimes n (chpos 1 0) st), Either.left { n = None })
+          | Either.Left 'o' -> (EditorState (m, ntimes n (chsize (max 1 (st.size / 10))) st), Either.left { n = None })
+          | Either.Left 'p' -> (EditorState (m, ntimes n (chsize (-max 1 (st.size / 10))) st), Either.left { n = None })

           | _ -> (EditorState (m, st), Either.left { n = None })
 end
 
           | _ -> (EditorState (m, st), Either.left { n = None })
 end
 


@@ -268,15 +278,15 @@ and Insert : (Mode with type initer = int) = struct
           let cell_types =
                   List.init 256 Char.chr |> List.filter_map (fun c -> M.of_char c |> Option.map (fun c' -> (c, c')))
           in
           let cell_types =
                   List.init 256 Char.chr |> List.filter_map (fun c -> M.of_char c |> Option.map (fun c' -> (c, c')))
           in

+          let sy = Raylib.get_screen_height () in

           List.iteri
           List.iteri

-            (fun i (c, c') ->
-              let r, g, b = M.color c' in
+            (fun i (ch, c) ->
+              let r, g, b = M.color c in

               let r, g, b = (int_of_char r, int_of_char g, int_of_char b) in
               let r, g, b = (int_of_char r, int_of_char g, int_of_char b) in

-              Graphics.set_color (Graphics.rgb r g b);
-              Graphics.fill_rect (10 + (25 * i)) 10 25 25;
-              Graphics.set_color (Graphics.rgb 127 127 127);
-              Graphics.moveto (10 + (25 * i) + 8) 20;
-              Graphics.draw_string (String.make 1 c))
+              let c = Raylib.Color.create r g b 255 in
+              Raylib.draw_rectangle (10 + (25 * i)) (sy - 35) 25 25 c;
+              let c = Raylib.Color.create 127 127 127 255 in
+              Raylib.draw_text (String.make 1 ch) (10 + (25 * i) + 8) (sy - 32) 20 c)

             cell_types
 
   let update (EditorState (m, st)) { col } =
             cell_types
 
   let update (EditorState (m, st)) { col } =


@@ -284,11 +294,13 @@ and Insert : (Mode with type initer = int) = struct
           let set_current ({ board; pos = x, y; _ } as st) c =
                   { st with board = Automata.set x y c board; pos = (x + 1, y) }
           in
           let set_current ({ board; pos = x, y; _ } as st) c =
                   { st with board = Automata.set x y c board; pos = (x + 1, y) }
           in

-          let next_line ({ pos = _, y; _ } as st) = { st with pos = (col, y - 1) } in
+          let next_line ({ pos = _, y; _ } as st) = { st with pos = (col, y + 1) } in

           function
           function

-          | '\e' -> (EditorState (m, st), Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())))
-          | '\r' -> (EditorState (m, next_line st), Either.left { col })
-          | c -> (
+          | Either.Right Raylib.Key.Escape ->
+                  (EditorState (m, st), Either.right (ModeAux.ModeAndState ((module Normal), Normal.initial ())))
+          | Either.Right Raylib.Key.Enter -> (EditorState (m, next_line st), Either.left { col })
+          | Either.Right _ -> (EditorState (m, st), Either.left { col })
+          | Either.Left c -> (

                   match M.of_char c with
                   | Some c -> (EditorState (m, set_current st c), Either.left { col })
                   | None -> (EditorState (m, st), Either.left { col }))
                   match M.of_char c with
                   | Some c -> (EditorState (m, set_current st c), Either.left { col })
                   | None -> (EditorState (m, st), Either.left { col }))

diff --git a/bin/modes.mli b/bin/modes.mli
index d6dfe0d7389499eab46feeda939a5cbe8a892fe5..0583e0f2b622e2e9392c7f058398611ae9b3fffd 100644 (file)
--- a/bin/modes.mli
+++ b/bin/modes.mli
@@ -17,6 +17,8 @@ type editor_state
 
 val default_state : editor_state
 
 
 val default_state : editor_state
 

+val should_close : editor_state -> bool
+

 module rec ModeAux : sig
   type mode_and_state = ModeAndState : (module ModeAux.S with type state = 'a) * 'a -> mode_and_state
 
 module rec ModeAux : sig
   type mode_and_state = ModeAndState : (module ModeAux.S with type state = 'a) * 'a -> mode_and_state
 


@@ -29,7 +31,8 @@ module rec ModeAux : sig
 
     val render : editor_state -> state -> unit
 
 
     val render : editor_state -> state -> unit
 

-    val update : editor_state -> state -> char -> editor_state * (state, mode_and_state) Either.t
+    val update :
+      editor_state -> state -> (char, Raylib.Key.t) Either.t -> editor_state * (state, mode_and_state) Either.t

   end
 end
 
   end
 end
 

diff --git a/dune-project b/dune-project
index dd1b1b72ba9cab95a63194d1ade4a8ebaf07a476..b046e9449bc4a6ba52d76ea3f5bdfa0166d81585 100644 (file)
--- a/dune-project
+++ b/dune-project
@@ -18,5 +18,5 @@
  (name cells)
  (synopsis "Un simulateur d'automates cellulaires.")
  (description "Un système pour simuler n'importe quel automate cellulaire en deux dimensions (à condition d'en faire un module OCaml).")
  (name cells)
  (synopsis "Un simulateur d'automates cellulaires.")
  (description "Un système pour simuler n'importe quel automate cellulaire en deux dimensions (à condition d'en faire un module OCaml).")

- (depends ocaml dune graphics)
+ (depends ocaml dune raylib)

  (tags ("cellular" "automaton" "automata")))
  (tags ("cellular" "automaton" "automata")))