compose tetris HUD scene

assets/main.scene

@@ -1,17 +1,31 @@
 (scene
- (object
+ (object root
-  (name root)
 
-  (object
+  (object playfield
-   (name box_red)
+   (transform (tx -160) (ty 320))
-   (transform (tx -5) (ty -5))
+   (sprite hud grid)
-   (sprite
+   (sprite hud field)
-    (rect -50 -50 50 50)
+   (object blocks
-    (fill 0xff0000)))
+    (sprite blocks L (pos 0 0))
+    (sprite blocks L (pos 32 0))
+    (sprite blocks L (pos 64 0))
+    (sprite blocks L (pos 64 -32))))
 
-  (object
+  (object hold
-   (name box_blue)
+   (transform (tx -272) (ty -272))
-   (transform (tx 5) (ty 5))
+   (sprite hud hold))
-   (sprite
+
-    (rect -50 -50 50 50)
+  (object next
-    (fill 0x0055ff)))))
+   (transform (tx 272) (ty -272))
+   (sprite hud next))
+
+  (object left_labels
+   (transform (tx -172) (ty 320))
+   (sprite hud pps (pos -12 -148))
+   (sprite hud kpp (pos -12 -116))
+   (sprite hud time (pos 0 -25))
+   (sprite hud num (pos 0 -73)))
+
+  (object right_labels
+   (transform (tx 272) (ty 320))
+   (sprite hud lines_rem (pos 0 -20)))))

gen_sprites.sh

@@ -16,7 +16,7 @@ mkdir -p $out_dir
 
 function gen() {
     name=$1
-    dpi=${2:-92}
+    dpi=${2:-96}
 
     echo "$name..."
 

src/main.ml

@@ -13,12 +13,14 @@ let main () =
   let ren = Renderer.make ~wnd in
   info (fun m -> m "renderer initialized");
 
-  let blocks = Asset.load_sprite_map "blocks" ~dpi:192 in
+  let sg = SG.make () in
+  SG.register_sprite_map sg "blocks"
+    (Asset.load_sprite_map "blocks" ~dpi:192);
+  SG.register_sprite_map sg "hud"
+    (Asset.load_sprite_map "hud");
   debug (fun m -> m "loaded assets");
 
   let tg = TG.make () in
-  let sg = SG.make () in
-
   let scene = Scene.load "main" ~tg ~sg in
   let root = Scene.get scene "root" in
   debug (fun m -> m "loaded scene");
@@ -28,26 +30,17 @@ let main () =
 
       let tf = TG.model (Scene.transform root) in
       begin
-        let tx = 512.0 in
+        let tx = 512.0 +. Float.sin (time *. 3.0) *. 20.0 in
         let ty = 400.0 in
         let _ = time in
         Mat2A.set tf ~tx ~ty ~sx:1.0 ~sy:1.0
       end;
 
       Renderer.pre_draw ren;
-      Renderer.clear ren (rgb24 0x000000);
+      Renderer.clear ren (rgb24 0x131321);
 
       TG.update tg;
-      (* SG.render sg ~ren; *)
+      SG.render sg ~ren;
-
-      Renderer.draw_sprite ren (Sprite.get blocks "L")
-        ~tf ~pos:(vec2 0.0 0.0);
-      Renderer.draw_sprite ren (Sprite.get blocks "O")
-        ~tf ~pos:(vec2 32.0 0.0);
-      Renderer.draw_sprite ren (Sprite.get blocks "S")
-        ~tf ~pos:(vec2 0.0 32.0);
-      Renderer.draw_sprite ren (Sprite.get blocks "Z")
-        ~tf ~pos:(vec2 32.0 32.0);
 
       Renderer.post_draw ren;
 

src/n2/n2.ml

@@ -34,7 +34,7 @@ module Transform_graph = struct
     t.buffer.(t.size) <- n;
     t.size <- t.size + 1
 
-  let add ?(parent = Null) t =
+  let add t parent =
     let model_tf = mat2a 0.0 0.0 1.0 1.0 in
     let world_tf = mat2a 0.0 0.0 1.0 1.0 in
     let node =
@@ -75,37 +75,49 @@ module Sprite_graph = struct
   include (val Ohlog.sublogs logger "SG")
 
   type t = {
+    sprite_maps : (string, S2.Sprite.map) Hashtbl.t;
     mutable list_rev : node list;
     mutable list : node list;
   }
 
   and node = {
     tf : mat2a;
-    bb : aabb;
+    pos : vec2;
-    fill : color;
+    sprite : S2.Sprite.t;
+    (* tint : color; *)
     (* mutable remove : bool; *)
   }
 
   let make () = {
+    sprite_maps = Hashtbl.create 128;
     list_rev = [];
     list = [];
   }
 
+  let register_sprite_map t name map =
+    Hashtbl.replace t.sprite_maps name map
+
+  let get_sprite t map_name sprite_name =
+    let map = try Hashtbl.find t.sprite_maps map_name
+      with Not_found -> Format.kasprintf failwith "no sprite map %S" map_name
+    in
+    S2.Sprite.get map sprite_name
+
   let push t node =
     begin
       t.list_rev <- node :: t.list_rev;
       t.list <- [];
     end
 
-  let add_rect t ~tf ~bb ~fill =
+  let add t ~tf ~pos ~sprite =
-    let node = { tf; bb; fill } in
+    let node = { tf; pos; sprite } in
     push t node;
     node
 
   let rec render_rec ren = function
     | [] -> ()
-    | { tf; bb; fill } :: nodes ->
+    | { tf; pos; sprite } :: nodes ->
-      S2.Renderer.draw_rect ren bb ~tf ~fill;
+      S2.Renderer.draw_sprite ren sprite ~tf ~pos;
       render_rec ren nodes
 
   let render t ~ren =
@@ -176,39 +188,34 @@ module Scene = struct
     | sexp ->
       of_sexp_error "bad argument to transform" sexp
 
-  let parse_sprite_arg ~(rect : aabb) ~(fill : color) = function
+  let parse_sprite_arg ~(pos : vec2) = function
-    | Sexp.List [Atom "rect"; x0; x1; y0; y1] ->
+    | Sexp.List [Atom "pos"; x; y] ->
-      AABB.set rect
+      Vec2.set pos
-        ~x0:(float_of_sexp x0)
+        ~x:(float_of_sexp x)
-        ~y0:(float_of_sexp x1)
+        ~y:(float_of_sexp y)
-        ~x1:(float_of_sexp y0)
+    (* | Sexp.List [Atom "tint"; rgb] -> *)
-        ~y1:(float_of_sexp y1)
+    (*   Color.set_rgb24 tint *)
-    | Sexp.List [Atom "fill"; rgb] ->
+    (*     (Sexplib.Conv.int_of_sexp rgb) *)
-      Color.set_rgb24 fill
-        (Sexplib.Conv.int_of_sexp rgb)
-    | Sexp.List [Atom "fill"; r; g; b] ->
-      begin
-        fill.r <- float_of_sexp r;
-        fill.g <- float_of_sexp g;
-        fill.b <- float_of_sexp b;
-      end
     | sexp ->
       of_sexp_error "bad argument to sprite" sexp
 
   let parse_sprite ~sg ~tf = function
-    | Sexp.List (Atom "sprite" :: args) ->
+    | Sexp.List (Atom "sprite" :: Atom map :: Atom sprite :: args) ->
-      let rect = aabb 0.0 0.0 0.0 0.0 in
+      let sprite = Sprite_graph.get_sprite sg map sprite in
-      let fill = Color.white () in
+      let pos = vec2 0.0 0.0 in
-      List.iter (parse_sprite_arg ~rect ~fill) args;
+      List.iter (parse_sprite_arg ~pos) args;
-      Sprite_graph.add_rect sg ~tf ~bb:rect ~fill
+      Sprite_graph.add sg ~tf ~pos ~sprite
     | sexp ->
       of_sexp_error "invalid sprite" sexp
 
   let rec parse_obj t ~tg ~sg ~parent = function
     | Sexp.List (Atom "object" :: args) ->
       trace (fun m -> m "parse_obj");
-      let parent_tf = Option.map (fun o -> o.transform) parent in
+      let ptgn = match parent with
-      let transform = Transform_graph.add tg ?parent:parent_tf in
+        | None -> Transform_graph.Null
+        | Some parent -> parent.transform
+      in
+      let transform = Transform_graph.add tg ptgn in
       let obj = { name = None; transform; sprites = [] } in
       let obj = parse_obj_args t obj args ~tg ~sg in
       Option.iter
@@ -222,7 +229,7 @@ module Scene = struct
     | [] -> { obj with sprites = List.rev obj.sprites }
     | arg :: args ->
       match arg with
-      | Sexp.List [Atom "name"; Atom name] ->
+      | Atom name ->
         trace (fun m -> m "parse_obj_args: name=%S" name);
         let obj = { obj with name = Some name } in
         parse_obj_args t obj args ~tg ~sg
@@ -235,9 +242,6 @@ module Scene = struct
         let tf = Transform_graph.world obj.transform in
         let spr = parse_sprite arg ~sg ~tf in
         let obj = { obj with sprites = spr :: obj.sprites } in
-        trace (fun m -> m "parse_obj_args: sprite %a %a"
-                          Color.pp spr.fill
-                          AABB.pp spr.bb);
         parse_obj_args t obj args ~tg ~sg
       | Sexp.List (Atom "object" :: _) ->
         trace (fun m -> m "parse_obj_args: begin object");

src/n2/n2.mli

@@ -8,9 +8,10 @@ module Transform_graph : sig
   val make : unit -> t
   val update : t -> unit
 
-  val add : ?parent:node -> t -> node
   val model : node -> mat2a
   val world : node -> mat2a
+
+  (* val add : ?parent:node -> t -> node *)
 end
 
 module Sprite_graph : sig
@@ -18,9 +19,10 @@ module Sprite_graph : sig
   type node
 
   val make : unit -> t
+  val register_sprite_map : t -> string -> Sprite.map -> unit
   val render : t -> ren:Renderer.t -> unit
 
-  val add_rect : t -> tf:mat2a -> bb:aabb -> fill:color -> node
+  (* val add_rect : t -> tf:mat2a -> bb:aabb -> fill:color -> node *)
 end
 
 module Scene : sig

src/s2/sprite.ml

@@ -19,7 +19,7 @@ let make ~texture ~pdf ~x ~y ~w ~h ~ox ~oy =
   and ox0 = Float.of_int (x - ox)
   and oy0 = Float.of_int (y - oy)
   and ox1 = Float.of_int (x - ox + w)
-  and oy1 = Float.of_int (y - oy + w)
+  and oy1 = Float.of_int (y - oy + h)
   in {
     texture;
     clip = aabb x0 y0 x1 y1;
@@ -61,10 +61,13 @@ let parse_sprite ~map ~texture ~pdf = function
   | sexp ->
     Sexp_conv.of_sexp_error "invalid sprite" sexp
 
-let of_sexp ~texture ?(dpi = 96) = function
+let of_sexp ~texture ?dpi = function
   | Sexp.List (Atom "map" :: sprite_args) ->
     let map = Hashtbl.create (List.length sprite_args * 2) in
-    let pdf = Float.of_int dpi /. 96.0 in
+    let pdf = match dpi with
+      | Some dpi -> Float.of_int dpi /. 96.0
+      | None -> 1.0
+    in
     List.iter (parse_sprite ~map ~texture ~pdf) sprite_args;
     map
   | sexp ->