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
-       ocaml-graphics
+       raylib-ocaml
 
 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)
- (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/>.
  *)
 
+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
+                Raylib.begin_drawing ();
                 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 () =
-        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/>.
  *)
 
-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
 
@@ -21,9 +21,13 @@ let default_state =
         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
 
+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
 
@@ -36,7 +40,8 @@ module rec ModeAux : sig
 
     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
@@ -47,10 +52,10 @@ let get_name (m : (module Automata.Automaton)) =
         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 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)
@@ -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
-            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;
-        Graphics.set_color (Graphics.rgb 127 127 127);
+        let c = Raylib.Color.create 127 127 127 255 in
         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
-          Graphics.moveto 0 (y * size);
-          Graphics.lineto sx (y * size)
+          Raylib.draw_line 0 (y * size) sx (y * size) c
         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
@@ -83,19 +90,17 @@ module rec Command : (Mode with type initer = string) = struct
   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;
-          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 ->
-              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
@@ -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
-            | ["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 ())) )
@@ -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
-                            ( 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;
@@ -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
-                              ((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;
@@ -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 ())))
 
-  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
@@ -237,21 +245,23 @@ and Normal : (Mode with type initer = unit) = struct
                   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 } )
-          | 'i' ->
+          | Either.Left 'i' ->
                   ( 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
 
@@ -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 sy = Raylib.get_screen_height () in
           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
-              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 } =
@@ -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 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
-          | '\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 }))

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 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
 
@@ -29,7 +31,8 @@ module rec ModeAux : sig
 
     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
 

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).")
- (depends ocaml dune graphics)
+ (depends ocaml dune raylib)
  (tags ("cellular" "automaton" "automata")))