Permalink
Browse files

this doesn't seem to speed things up

  • Loading branch information...
dwrensha committed Dec 30, 2012
1 parent 0982c0a commit c9e9f6fa8553163f0b1929e234b17035737c4700
View
@@ -9,7 +9,7 @@ VERSION_TARGET=10.2
FRAMEWORKS=functioning/OSX/Frameworks
CPPFLAGS=-I/usr/local/include -I${FRAMEWORKS}/SDL.framework/Versions/Current/Headers -I${FRAMEWORKS}/SDL_net.framework/Versions/Current/Headers -I${FRAMEWORKS}/SDL_mixer.framework/Versions/Current/Headers -I${FRAMEWORKS}/SDL_image.framework/Versions/Current/Headers -D_THREAD_SAFE -DOSX
LIBS=-L/usr/lib
-DEBUG_MLTON_FLAGS=#-const 'Exn.keepHistory true'
+DEBUG_MLTON_FLAGS=#-profile alloc #-const 'Exn.keepHistory true'
MLTON_FLAGS=$(DEBUG_MLTON_FLAGS) -verbose 1 -cc-opt "-g -Dmain=SDL_main" -link-opt "-Wl,-rpath,@executable_path/../Frameworks -F${FRAMEWORKS} -framework SDL_net -framework SDL_image ${LIBS} -framework SDL -framework OpenGL -framework AGL -framework IOKit -framework Carbon -framework Cocoa -framework SDL_mixer" -default-ann 'allowFFI true'
RELEASEFILES=$(OUTPUT_EXE) media COPYING
View
@@ -114,7 +114,7 @@ struct
(D.B.get_fixture_list b);
(* Destroy the attached contacts. *)
oapp D.E.get_next
- (fn ce0 => D.W.CM.destroy (w, !!(D.E.get_contact ce0)))
+ (fn ce0 => D.W.CM.destroy (w, (D.E.get_contact ce0)))
(D.B.get_contact_list b);
(* Clear them. *)
D.B.set_contact_list (b, NONE)
@@ -489,7 +489,7 @@ struct
D.B.set_torque (b, 0.0);
(* Since the body type changed, we need to flag
contacts for filtering. *)
- oapp D.E.get_next (D.C.flag_for_filtering o !! o
+ oapp D.E.get_next (D.C.flag_for_filtering o
D.E.get_contact)
(D.B.get_contact_list b)
end
View
@@ -136,8 +136,8 @@ sig
val get_flags : ('b, 'f, 'j) contact -> (Word32.word)
val get_prev : ('b, 'f, 'j) contact -> (('b, 'f, 'j) contact option)
val get_next : ('b, 'f, 'j) contact -> (('b, 'f, 'j) contact option)
- val get_node_a : ('b, 'f, 'j) contact -> (('b, 'f, 'j) contactedge)
- val get_node_b : ('b, 'f, 'j) contact -> (('b, 'f, 'j) contactedge)
+ val get_node_a : ('b, 'f, 'j) contact -> (('b, 'f, 'j) contactedge option)
+ val get_node_b : ('b, 'f, 'j) contact -> (('b, 'f, 'j) contactedge option)
val get_fixture_a : ('b, 'f, 'j) contact -> (('b, 'f, 'j) fixture)
val get_fixture_b : ('b, 'f, 'j) contact -> (('b, 'f, 'j) fixture)
val get_manifold : ('b, 'f, 'j) contact -> (BDDTypes.manifold)
@@ -150,8 +150,8 @@ sig
val set_flags : ('b, 'f, 'j) contact * (Word32.word) -> unit
val set_prev : ('b, 'f, 'j) contact * (('b, 'f, 'j) contact option) -> unit
val set_next : ('b, 'f, 'j) contact * (('b, 'f, 'j) contact option) -> unit
- val set_node_a : ('b, 'f, 'j) contact * (('b, 'f, 'j) contactedge) -> unit
- val set_node_b : ('b, 'f, 'j) contact * (('b, 'f, 'j) contactedge) -> unit
+ val set_node_a : ('b, 'f, 'j) contact * (('b, 'f, 'j) contactedge option) -> unit
+ val set_node_b : ('b, 'f, 'j) contact * (('b, 'f, 'j) contactedge option) -> unit
val set_fixture_a : ('b, 'f, 'j) contact * (('b, 'f, 'j) fixture) -> unit
val set_fixture_b : ('b, 'f, 'j) contact * (('b, 'f, 'j) fixture) -> unit
val set_manifold : ('b, 'f, 'j) contact * (BDDTypes.manifold) -> unit
@@ -165,8 +165,8 @@ sig
flags : Word32.word,
prev : ('b, 'f, 'j) contact option,
next : ('b, 'f, 'j) contact option,
- node_a : ('b, 'f, 'j) contactedge,
- node_b : ('b, 'f, 'j) contactedge,
+ node_a : ('b, 'f, 'j) contactedge option,
+ node_b : ('b, 'f, 'j) contactedge option,
fixture_a : ('b, 'f, 'j) fixture,
fixture_b : ('b, 'f, 'j) fixture,
manifold : BDDTypes.manifold,
@@ -180,19 +180,19 @@ sig
structure E :
sig
- val get_other : ('b, 'f, 'j) contactedge -> (('b, 'f, 'j) body option)
- val get_contact : ('b, 'f, 'j) contactedge -> (('b, 'f, 'j) contact option)
+ val get_other : ('b, 'f, 'j) contactedge -> (('b, 'f, 'j) body)
+ val get_contact : ('b, 'f, 'j) contactedge -> (('b, 'f, 'j) contact)
val get_prev : ('b, 'f, 'j) contactedge -> (('b, 'f, 'j) contactedge option)
val get_next : ('b, 'f, 'j) contactedge -> (('b, 'f, 'j) contactedge option)
- val set_other : ('b, 'f, 'j) contactedge * (('b, 'f, 'j) body option) -> unit
- val set_contact : ('b, 'f, 'j) contactedge * (('b, 'f, 'j) contact option) -> unit
+ val set_other : ('b, 'f, 'j) contactedge * (('b, 'f, 'j) body) -> unit
+ val set_contact : ('b, 'f, 'j) contactedge * (('b, 'f, 'j) contact) -> unit
val set_prev : ('b, 'f, 'j) contactedge * (('b, 'f, 'j) contactedge option) -> unit
val set_next : ('b, 'f, 'j) contactedge * (('b, 'f, 'j) contactedge option) -> unit
val new : {
- other : ('b, 'f, 'j) body option,
- contact : ('b, 'f, 'j) contact option,
+ other : ('b, 'f, 'j) body,
+ contact : ('b, 'f, 'j) contact,
prev : ('b, 'f, 'j) contactedge option,
next : ('b, 'f, 'j) contactedge option } -> ('b, 'f, 'j) contactedge
val eq : ('b, 'f, 'j) contactedge * ('b, 'f, 'j) contactedge -> bool
View
@@ -44,8 +44,8 @@ struct
flags : (Word32.word) ref,
prev : (('b, 'f, 'j) contactcell option) ref,
next : (('b, 'f, 'j) contactcell option) ref,
- node_a : (('b, 'f, 'j) contactedgecell) ref,
- node_b : (('b, 'f, 'j) contactedgecell) ref,
+ node_a : (('b, 'f, 'j) contactedgecell option) ref,
+ node_b : (('b, 'f, 'j) contactedgecell option) ref,
fixture_a : (('b, 'f, 'j) fixturecell) ref,
fixture_b : (('b, 'f, 'j) fixturecell) ref,
manifold : (BDDTypes.manifold) ref,
@@ -56,8 +56,8 @@ struct
tangent_speed : (real) ref }
and ('b, 'f, 'j) contactedgecell = E of {
- other : (('b, 'f, 'j) bodycell option) ref,
- contact : (('b, 'f, 'j) contactcell option) ref,
+ other : (('b, 'f, 'j) bodycell) ref,
+ contact : (('b, 'f, 'j) contactcell) ref,
prev : (('b, 'f, 'j) contactedgecell option) ref,
next : (('b, 'f, 'j) contactedgecell option) ref }
View
@@ -33,6 +33,11 @@ struct
"(e.g. fixture, joint) was used after being detached, " ^
"or before being initialized: " ^ s)
+ fun !!! (SOME x) = x
+ | !!! NONE = raise Fail ""
+
+
+
type ('b, 'f, 'j) body = ('b, 'f, 'j) BDDCells.body
type ('b, 'f, 'j) fixture = ('b, 'f, 'j) BDDCells.fixture
type ('b, 'f, 'j) contact = ('b, 'f, 'j) BDDCells.contact
@@ -418,8 +423,8 @@ struct
struct
open BDDCells.E
- fun new () = BDDCells.E.new { contact = NONE, other = NONE,
- prev = NONE, next = NONE }
+ fun new (other, contact) = BDDCells.E.new { contact = contact, other = other,
+ prev = NONE, next = NONE }
end
(* Internal, contacts *)
@@ -495,8 +500,7 @@ struct
case (F.get_shape fixture_a, F.get_shape fixture_b) of
(BDDShape.Circle _, BDDShape.Polygon _) => (fixture_b, fixture_a)
| _ => (fixture_a, fixture_b)
- in
- BDDCells.C.new { flags = FLAG_ENABLED,
+ val c = BDDCells.C.new { flags = FLAG_ENABLED,
fixture_a = fixture_a,
fixture_b = fixture_b,
manifold = { point_count = 0,
@@ -507,15 +511,19 @@ struct
local_point = vec2 (0.0, 0.0) },
prev = NONE,
next = NONE,
- node_a = E.new (),
- node_b = E.new (),
+ node_a = NONE,
+ node_b = NONE,
toi_count = 0,
toi = 0.0,
friction = mix_friction (F.get_friction fixture_a,
F.get_friction fixture_b),
restitution = mix_restitution (F.get_restitution fixture_a,
F.get_restitution fixture_b),
tangent_speed = 0.0 }
+ in
+ set_node_a (c, SOME (E.new (F.get_body fixture_b, c)));
+ set_node_b (c, SOME (E.new (F.get_body fixture_a, c)));
+ c
end
end
@@ -574,7 +582,7 @@ struct
else ()
(* Remove from body A *)
- val nodea = C.get_node_a c
+ val nodea = !!!(C.get_node_a c)
val prev = E.get_prev nodea
val next = E.get_next nodea
val () = case prev of
@@ -592,7 +600,7 @@ struct
else ()
(* Remove from body B *)
- val nodeb = C.get_node_b c
+ val nodeb = !!!(C.get_node_b c)
val prev = E.get_prev nodeb
val next = E.get_next nodeb
val () = case prev of
@@ -622,10 +630,10 @@ struct
(* Just raises Return if a contact already exists. *)
fun one_edge e =
- if oeq B.eq (SOME body_a, E.get_other e)
+ if B.eq (body_a, E.get_other e)
then
- let val fa = C.get_fixture_a (!! "fa" (E.get_contact e))
- val fb = C.get_fixture_b (!! "fb" (E.get_contact e))
+ let val fa = C.get_fixture_a ((E.get_contact e))
+ val fb = C.get_fixture_b ((E.get_contact e))
in
if (F.eq(fa, fixture_a) andalso F.eq(fb, fixture_b)) orelse
(F.eq(fa, fixture_b) andalso F.eq(fb, fixture_a))
@@ -671,19 +679,19 @@ struct
val () = set_contact_list (world, SOME c)
(* Connect to island graph. *)
- val node_a = C.get_node_a c
- val () = E.set_contact (node_a, SOME c)
- val () = E.set_other (node_a, SOME body_b)
+ val node_a = !!!(C.get_node_a c)
+ val () = E.set_contact (node_a, c)
+(* val () = E.set_other (node_a, SOME body_b) *)
val () = E.set_next (node_a, B.get_contact_list body_a)
val () = case B.get_contact_list body_a of
NONE => ()
| SOME prev => E.set_prev (prev, SOME node_a)
val () = B.set_contact_list (body_a, SOME node_a)
- val node_b = C.get_node_b c
- val () = E.set_contact (node_b, SOME c)
- val () = E.set_other (node_b, SOME body_a)
+ val node_b = !!!(C.get_node_b c)
+ val () = E.set_contact (node_b, c)
+(* val () = E.set_other (node_b, SOME body_a) *)
val () = E.set_next (node_b, B.get_contact_list body_b)
val () = case B.get_contact_list body_b of
View
@@ -90,7 +90,7 @@ struct
(oapp D.E.get_next
(fn edge =>
let
- val contact = !!(D.E.get_contact edge)
+ val contact = (D.E.get_contact edge)
val fixture_a = D.C.get_fixture_a contact
val fixture_b = D.C.get_fixture_b contact
in
View
@@ -72,8 +72,8 @@ fun contact cc = ("C", "Contact", "contact", "CONTACT",
("prev", cc "contact" ^ " option"),
("next", cc "contact" ^ " option"),
(* nodes for connecting bodies *)
- ("node_a", cc "contactedge"),
- ("node_b", cc "contactedge"),
+ ("node_a", cc "contactedge" ^ " option"),
+ ("node_b", cc "contactedge" ^ " option"),
(* Port note: made these non-optional. *)
("fixture_a", cc "fixture"),
("fixture_b", cc "fixture"),
@@ -95,8 +95,8 @@ fun contactedge cc = ("E", "ContactEdge", "contactedge", "CONTACTEDGE",
PERF: Do these really need to be optional?
See World.ContactManager.add_pair. Could pass them
to 'new' or do initialization in that function. *)
- ("other", cc "body" ^ " option"),
- ("contact", cc "contact" ^ " option"),
+ ("other", cc "body"),
+ ("contact", cc "contact"),
(* the previous and next contact edge in the
body's contact list *)
("prev", cc "contactedge" ^ " option"),
View
@@ -234,8 +234,8 @@ struct
(D.G.set_prev (j, SOME edge_b);
D.G.set_next (edge_b, SOME j))
val () = D.B.set_joint_list (body_b, SOME edge_b)
- fun one_edge ce = if D.B.eq (!!(D.E.get_other ce), body_a)
- then D.C.flag_for_filtering (!! (D.E.get_contact ce))
+ fun one_edge ce = if D.B.eq ((D.E.get_other ce), body_a)
+ then D.C.flag_for_filtering ((D.E.get_contact ce))
else ()
val () =
if collide_connected then ()
@@ -318,8 +318,8 @@ struct
(* If the joint prevents collisions, then flag any contacts for filtering. *)
(* Port note: this is exactly the same code as in create_joint. *)
- fun one_edge ce = if D.B.eq (!!(D.E.get_other ce), body_a)
- then D.C.flag_for_filtering (!! (D.E.get_contact ce))
+ fun one_edge ce = if D.B.eq ((D.E.get_other ce), body_a)
+ then D.C.flag_for_filtering ((D.E.get_contact ce))
else ()
in
if D.J.get_collide_connected joint
@@ -349,10 +349,8 @@ struct
(* Delete the attached contacts. *)
fun one_contactedge ce =
ContactManager.destroy
- (world,
- case D.E.get_contact ce of
- NONE => raise BDDWorld "contact edge had no contact?"
- | SOME c => c)
+ (world, D.E.get_contact ce )
+
val () = oapp D.E.get_next one_contactedge (D.B.get_contact_list
body)
val () = D.B.set_contact_list (body, NONE)
@@ -538,7 +536,7 @@ struct
joints, which might include other bodies in the
island. *)
fun one_cedge (ce : contactedge) =
- let val contact = !! (D.E.get_contact ce)
+ let val contact = D.E.get_contact ce
val fixture_a = D.C.get_fixture_a contact
val fixture_b = D.C.get_fixture_b contact
in
@@ -561,7 +559,7 @@ struct
then ()
else
let
- val other : body = !! (D.E.get_other ce)
+ val other : body = (D.E.get_other ce)
in
D.C.set_flag (contact, D.C.FLAG_ISLAND);
contacts := contact :: !contacts;
@@ -820,15 +818,15 @@ struct
fun onecontactedge ce =
let
(* TODO bodyCapacity? contactCapacity? *)
- val contact = !! (D.E.get_contact ce)
+ val contact = (D.E.get_contact ce)
(* Has this contact already been added to the island? *)
val () = if D.C.get_flag (contact, D.C.FLAG_ISLAND)
then raise Continue
else ()
(* Only add static, kinemetic, or bullet bodies. *)
- val other = !! (D.E.get_other ce)
+ val other = (D.E.get_other ce)
val () = if Body.get_type other = T.Dynamic andalso
(not (Body.get_bullet b)) andalso
(not (Body.get_bullet other))
@@ -913,8 +911,8 @@ struct
let
val () = D.B.synchronize_fixtures (body, get_broad_phase world)
fun onece ce =
- ( D.C.clear_flag (!! (D.E.get_contact ce), D.C.FLAG_TOI);
- D.C.clear_flag (!! (D.E.get_contact ce), D.C.FLAG_ISLAND)
+ ( D.C.clear_flag ((D.E.get_contact ce), D.C.FLAG_TOI);
+ D.C.clear_flag ((D.E.get_contact ce), D.C.FLAG_ISLAND)
)
val () = oapp D.E.get_next onece (D.B.get_contact_list body)
in

0 comments on commit c9e9f6f

Please sign in to comment.