refactor string->sexp happens in S2

This commit is contained in:
tali 2024-01-19 15:14:22 -05:00
parent 5ce8d30f89
commit d6882feb15
5 changed files with 40 additions and 41 deletions

View File

@ -5,4 +5,4 @@
adam adam
s2 s2
ohlog ohlog
sexplib)) sexplib0))

View File

@ -1,5 +1,4 @@
open Adam open Adam
module Sexp = Sexplib0.Sexp
include (val Ohlog.logs "N2") include (val Ohlog.logs "N2")
@ -144,6 +143,9 @@ end
*) *)
module Scene = struct module Scene = struct
module Sexp = Sexplib0.Sexp
open Sexplib0.Sexp_conv
include (val Ohlog.sublogs logger "Scene") include (val Ohlog.sublogs logger "Scene")
type t = { type t = {
@ -156,36 +158,42 @@ module Scene = struct
sprites : Sprite_graph.node list; sprites : Sprite_graph.node list;
} }
let get t name = try Hashtbl.find t.objs name
with Not_found ->
Format.ksprintf failwith "no node %S in scene" name
let transform obj = obj.transform
let parse_transform_arg ~(tf : mat2a) = function let parse_transform_arg ~(tf : mat2a) = function
| Sexp.List [Atom "tx"; arg] -> | Sexp.List [Atom "tx"; arg] ->
tf.a2 <- Sexplib.Conv.float_of_sexp arg tf.a2 <- float_of_sexp arg
| Sexp.List [Atom "ty"; arg] -> | Sexp.List [Atom "ty"; arg] ->
tf.a5 <- Sexplib.Conv.float_of_sexp arg tf.a5 <- float_of_sexp arg
| Sexp.List [Atom "sx"; arg] -> | Sexp.List [Atom "sx"; arg] ->
tf.a0 <- Sexplib.Conv.float_of_sexp arg tf.a0 <- float_of_sexp arg
| Sexp.List [Atom "sy"; arg] -> | Sexp.List [Atom "sy"; arg] ->
tf.a4 <- Sexplib.Conv.float_of_sexp arg tf.a4 <- float_of_sexp arg
| sexp -> | sexp ->
Sexplib.Conv.of_sexp_error "bad argument to transform" sexp of_sexp_error "bad argument to transform" sexp
let parse_sprite_arg ~(rect : aabb) ~(fill : color) = function let parse_sprite_arg ~(rect : aabb) ~(fill : color) = function
| Sexp.List [Atom "rect"; x0; x1; y0; y1] -> | Sexp.List [Atom "rect"; x0; x1; y0; y1] ->
AABB.set rect AABB.set rect
~x0:(Sexplib.Conv.float_of_sexp x0) ~x0:(float_of_sexp x0)
~y0:(Sexplib.Conv.float_of_sexp x1) ~y0:(float_of_sexp x1)
~x1:(Sexplib.Conv.float_of_sexp y0) ~x1:(float_of_sexp y0)
~y1:(Sexplib.Conv.float_of_sexp y1) ~y1:(float_of_sexp y1)
| Sexp.List [Atom "fill"; rgb] -> | Sexp.List [Atom "fill"; rgb] ->
Color.set_rgb24 fill Color.set_rgb24 fill
(Sexplib.Conv.int_of_sexp rgb) (Sexplib.Conv.int_of_sexp rgb)
| Sexp.List [Atom "fill"; r; g; b] -> | Sexp.List [Atom "fill"; r; g; b] ->
begin begin
fill.r <- Sexplib.Conv.float_of_sexp r; fill.r <- float_of_sexp r;
fill.g <- Sexplib.Conv.float_of_sexp g; fill.g <- float_of_sexp g;
fill.b <- Sexplib.Conv.float_of_sexp b; fill.b <- float_of_sexp b;
end end
| sexp -> | sexp ->
Sexplib.Conv.of_sexp_error "bad argument to sprite" sexp of_sexp_error "bad argument to sprite" sexp
let parse_sprite ~sg ~tf = function let parse_sprite ~sg ~tf = function
| Sexp.List (Atom "sprite" :: args) -> | Sexp.List (Atom "sprite" :: args) ->
@ -194,7 +202,7 @@ module Scene = struct
List.iter (parse_sprite_arg ~rect ~fill) args; List.iter (parse_sprite_arg ~rect ~fill) args;
Sprite_graph.add_rect sg ~tf ~bb:rect ~fill Sprite_graph.add_rect sg ~tf ~bb:rect ~fill
| sexp -> | sexp ->
Sexplib.Conv.of_sexp_error "invalid sprite" sexp of_sexp_error "invalid sprite" sexp
let rec parse_obj t ~tg ~sg ~parent = function let rec parse_obj t ~tg ~sg ~parent = function
| Sexp.List (Atom "object" :: args) -> | Sexp.List (Atom "object" :: args) ->
@ -208,7 +216,7 @@ module Scene = struct
obj.name; obj.name;
obj obj
| sexp -> | sexp ->
Sexplib.Conv.of_sexp_error "invalid object" sexp of_sexp_error "invalid object" sexp
and parse_obj_args t obj ~tg ~sg = function and parse_obj_args t obj ~tg ~sg = function
| [] -> { obj with sprites = List.rev obj.sprites } | [] -> { obj with sprites = List.rev obj.sprites }
@ -237,7 +245,7 @@ module Scene = struct
trace (fun m -> m "parse_obj_args: end object"); trace (fun m -> m "parse_obj_args: end object");
parse_obj_args t obj args ~tg ~sg parse_obj_args t obj args ~tg ~sg
| sexp -> | sexp ->
Sexplib.Conv.of_sexp_error "bad argument to object" sexp of_sexp_error "bad argument to object" sexp
let of_sexp ~tg ~sg = function let of_sexp ~tg ~sg = function
| Sexp.List [Atom "scene"; root] -> | Sexp.List [Atom "scene"; root] ->
@ -248,27 +256,10 @@ module Scene = struct
t t
| sexp -> | sexp ->
Sexplib.Conv.of_sexp_error "invalid scene" sexp of_sexp_error "invalid scene" sexp
let load name ~tg ~sg = let load name ~tg ~sg =
let path = Format.sprintf "%s.scene" name in S2.Asset.load_sexp_conv
match Sexplib.Sexp.of_string_conv (name ^ ".scene")
(S2.Asset.load_file path)
(of_sexp ~tg ~sg) (of_sexp ~tg ~sg)
with
| `Result v ->
debug (fun m -> m "loaded scene %S" name);
v
| `Error (exn, _) ->
let msg = match exn with
| Failure msg -> msg
| exn -> Printexc.to_string exn
in
raise (S2.Asset.Error (path, "parse error: " ^ msg))
let get t name =
try Hashtbl.find t.objs name
with Not_found -> Format.ksprintf failwith "no node %S in scene" name
let transform obj = obj.transform
end end

View File

@ -1,6 +1,5 @@
open Adam open Adam
open S2 open S2
module Sexp = Sexplib0.Sexp
module Transform_graph : sig module Transform_graph : sig
type t type t

View File

@ -23,3 +23,11 @@ let load_file path =
| n -> read (i + n) | n -> read (i + n)
in in
Bytes.sub_string buf 0 (read 0) Bytes.sub_string buf 0 (read 0)
let load_sexp_conv path of_sexp =
try
load_file path
|> Sexplib.Sexp.of_string
|> of_sexp
with Sexplib.Conv.Of_sexp_error (Failure msg, _) ->
raise (Error (path, "parse error: " ^ msg))

View File

@ -6,4 +6,5 @@
ohlog ohlog
tsdl tsdl
tgls.tgl4)) tgls.tgl4
sexplib))