ECS scene builder

This commit is contained in:
milo 2024-02-05 16:19:51 -05:00
parent 74f5d9a3aa
commit 5476cf4c39
4 changed files with 152 additions and 35 deletions

View File

@ -11,33 +11,14 @@ let main () =
let ren = Renderer.make ~wnd in let ren = Renderer.make ~wnd in
info (fun m -> m "renderer initialized"); info (fun m -> m "renderer initialized");
(* let ctx = Scene.make_context () in *) let ctx = Scene.make_context () in
(* Scene.register_sprite_map ctx "blocks" (Asset.load_sprite_map "blocks" ~dpi:192); *) Scene.register_sprite_map ctx "blocks" (Asset.load_sprite_map "blocks" ~dpi:192);
(* Scene.register_sprite_map ctx "hud" (Asset.load_sprite_map "hud"); *) Scene.register_sprite_map ctx "hud" (Asset.load_sprite_map "hud");
(* Scene.register_font ctx "roman-md" (Asset.load_font "roman-md"); *) Scene.register_font ctx "roman-md" (Asset.load_font "roman-md");
(* Scene.register_font ctx "mono-sm" (Asset.load_font "mon-sm"); *) Scene.register_font ctx "mono-sm" (Asset.load_font "mono-sm");
(* let scene = Scene.load "main" in *) let scene = Scene.load "main" in
(* let root = Scene.build scene ctx in *) let root = build ctx scene in
(* debug (fun m -> m "loaded scene"); *) debug (fun m -> m "loaded scene");
let blocks = Asset.load_sprite_map "blocks" ~dpi:192 in
let root = Entity.make () ~name:"scene" in
Trans.init root;
begin
let en = Entity.make () in
Trans.init en ~parent:root;
Sprite.init en ~sprite_map:blocks;
Sprite.add en ~frame:"Z" ~pos:(vec2 0.0 0.0);
end;
begin
let en = Entity.make () in
Trans.init en ~parent:root;
Sprite.init en ~sprite_map:blocks;
Sprite.add en ~frame:"O" ~pos:(vec2 (-32.0) 0.0);
end;
let render time = let render time =
begin begin

View File

@ -1,3 +1,11 @@
include Adam include Adam
include S2 include S2
include (val Ohlog.logs "N2") include (val Ohlog.logs "N2")
let[@tail_mod_cons] rec flat_map f = function
| [] -> []
| x :: xs -> append_then_flat_map f xs (f x)
and[@tail_mod_cons] append_then_flat_map f xs = function
| [] -> flat_map f xs
| y :: ys -> y :: append_then_flat_map f xs ys

View File

@ -1,10 +1,12 @@
include (val Ohlog.logs "N2")
type en = Types.en
module Entity = Types.Entity module Entity = Types.Entity
type en = Entity.t
module Scene = Scene module Scene = Scene
let build = Scene.build let build = Scene.build
module Trans = Trans module Trans = Trans
let update_transforms = Trans.update_transforms let update_transforms = Trans.update_transforms
module Sprite = Render.Sprite module Sprite = Render.Sprite
module Label = Render.Label module Label = Render.Label
let render = Render.render let render = Render.render

View File

@ -15,17 +15,143 @@ let make_context () = {
trans_parent = None; trans_parent = None;
} }
let register_sprite_map cx k v = let register_sprite_map cx k v = Hashtbl.replace cx.sprite_maps k v
Hashtbl.replace cx.sprite_maps k v let get_sprite_map cx k = try Hashtbl.find cx.sprite_maps k
with Not_found -> Format.kasprintf failwith "no such sprite map %S" k
let register_font cx k v = let register_font cx k v = Hashtbl.replace cx.fonts k v
Hashtbl.replace cx.fonts k v let get_font cx k = try Hashtbl.find cx.fonts k
with Not_found -> Format.kasprintf failwith "no such font %S" k
type t = type t =
context -> en context -> en
let build cx f = f cx let build cx f = f cx
let rec each2 fs x y = match fs with
| [] -> ()
| [f] -> f x y
| f :: fs -> f x y; each2 fs x y
let of_sexp sexp =
() (* sexp conv *)
module Sexp = Sexplib0.Sexp
open Sexplib0.Sexp_conv
(* (transform <...>) *)
let parse_transform args =
let tf = mat2a () in
List.iter
(function
| Sexp.List [Atom "tx"; arg] ->
tf.a2 <- float_of_sexp arg
| Sexp.List [Atom "ty"; arg] ->
tf.a5 <- float_of_sexp arg
| Sexp.List [Atom "sx"; arg] ->
tf.a0 <- float_of_sexp arg
| Sexp.List [Atom "sy"; arg] ->
tf.a4 <- float_of_sexp arg
| sexp ->
of_sexp_error "bad argument to transform" sexp)
args;
tf
(* (sprites <map> <...>) *)
let rec parse_sprites = function
| Sexp.List (Atom "sprites" :: Atom map :: args) ->
let init cx en =
let sprite_map = get_sprite_map cx map in
Render.Sprite.init en ~sprite_map
in
init :: List.map parse_sprites_arg args
| sexp ->
of_sexp_error "invalid sprites" sexp
and parse_sprites_arg = function
| Sexp.List [Atom frame; x; y] ->
let pos = vec2 (float_of_sexp x) (float_of_sexp y) in
fun cx en -> Render.Sprite.add en ~frame ~pos
| Atom frame ->
let pos = vec2 0.0 0.0 in
fun cx en -> Render.Sprite.add en ~frame ~pos
| sexp ->
of_sexp_error "bad argument to sprites" sexp
(* (label <font> <text> <...>) *)
let rec parse_label = function
| Sexp.List (Atom "label" :: Atom font :: Atom text :: args) ->
let init cx en =
let font = get_font cx font in
Render.Label.init en ~font;
Render.Label.set_text en text
in
init :: List.map parse_label_arg args
| sexp ->
of_sexp_error "invalid label" sexp
and parse_label_arg = function
| Sexp.List [Atom "fg"; _rgb] ->
failwith "TODO: label: (fg <rgb>)"
| sexp ->
of_sexp_error "bad argument to label" sexp
(* (object [<name>] <...>) *)
let rec parse_obj = function
| Sexp.List (Atom "object" :: args) ->
let name, args = match args with
| Atom name :: args -> Some name, args
| args -> None, args
in
trace (fun m -> match name with
| Some n -> m "parse_obj %S" n
| None -> m "parse_obj %s" "(unnamed)");
let inits = flat_map parse_obj_arg args in
fun cx ->
let en = Entity.make ?name () in
Trans.init en ?parent:cx.trans_parent;
each2 inits cx en;
en
| sexp ->
of_sexp_error "invalid object" sexp
and parse_obj_arg = function
| Sexp.List (Atom "transform" :: args) ->
let tf = parse_transform args in
let init _cx en = Mat2A.copy (Trans.model en) ~src:tf in
[init]
| Sexp.List (Atom "sprites" :: _) as arg ->
parse_sprites arg
| Sexp.List (Atom "label" :: _) as arg ->
parse_label arg
| Sexp.List (Atom "object" :: _) as sexp ->
trace (fun m -> m "parse_obj_args: begin object");
let build = parse_obj sexp in
trace (fun m -> m "parse_obj_args: end object");
let init cx en = build { cx with trans_parent = Some en } |> ignore in
[init]
| sexp ->
of_sexp_error "bad argument to object" sexp
let of_sexp = function
| Sexp.List [Atom "scene"; root] ->
parse_obj root
| sexp ->
of_sexp_error "invalid scene" sexp
let load name =
S2.Asset.load_sexp_conv
(name ^ ".scene")
of_sexp