many small fixes for 4.00

META.ios

@@ -1,7 +1,7 @@
 version="0.01"
 archive(byte)="lightning.cma"
 archive(native)="lightning.cmxa"
-requires="bigarray extlib xmlm dbm ojson"
+requires="bigarray extlib xmlm ojson"
 
 package "tapjoy" (
   description="Tapjoy Connect"

META.sdl

@@ -1,7 +1,7 @@
 version="0.01"
 archive(byte)="lightning.cma"
 archive(native)="lightning.cmxa"
-requires="bigarray extlib xmlm dbm threads curl ojson"
+requires="bigarray extlib xmlm threads curl ojson"
 
 package "tapjoy" (
   description="Tapjoy Connect"

Makefile.common

@@ -1,7 +1,8 @@
 
 MLPPOPT = 
 MLFLAGS = -package camlp4,camlp4.macro -syntax camlp4r 
-MLCOMPFLAGS = -w +7+9@5@8-13 -warn-error +10 -g
+MLCOMPFLAGS = -w +7+9@5@8-13 -warn-error +10 -g 
+MLNATFLAGS = -S
 
 %.cmi: %.mli
 ifneq (,$(findstring byte,$(LIB)))
@@ -14,4 +15,4 @@ endif
 	$(OCAMLC) $(MLFLAGS) $(MLCOMPFLAGS) $(if $(MLPPOPT),$(patsubst %,-ppopt %,$(MLPPOPT))) $(if $(DEBUGS),$(patsubst %,-ppopt -enable-debug -ppopt %,$(DEBUGS))) -c $<
 
 %.cmx: %.ml
-	$(OCAMLOPT) $(MLFLAGS) $(MLCOMPFLAGS) $(if $(MLPPOPT),$(patsubst %,-ppopt %,$(MLPPOPT))) $(if $(DEBUGS),$(patsubst %,-ppopt -enable-debug -ppopt %,$(DEBUGS)))  -c $<
+	$(OCAMLOPT) $(MLFLAGS) $(MLNATFLAGS) $(MLCOMPFLAGS) $(if $(MLPPOPT),$(patsubst %,-ppopt %,$(MLPPOPT))) $(if $(DEBUGS),$(patsubst %,-ppopt -enable-debug -ppopt %,$(DEBUGS)))  -c $<

config.ios

@@ -1,16 +1,16 @@
 include myconfig.ios
 export PLATFORM = IOS
 SDK_VERSION ?= 5.1
-GCC ?= llvm-gcc
+GCC ?= gcc
 ARCH ?= armv7
 PLAT ?= /Applications/Xcode.app/Contents/Developer/Platforms/iPhoneOS.platform
 SDK ?= /Developer/SDKs/iPhoneOS$(SDK_VERSION).sdk
-OCAMLDIR = /usr/local/ocaml/ios/3.12.1
-export OCAMLFIND ?= /opt/local/bin/ocamlfind -toolchain ios
+OCAMLDIR ?= /usr/local/ocaml/ios/3.12.1
+export OCAMLFIND ?= ocamlfind -toolchain ios
 OCAMLBINDIR = $(OCAMLDIR)/bin/
 export CC = $(PLAT)/Developer/usr/bin/$(GCC) -arch $(ARCH)
-export CFLAGS = -x objective-c -std=c99 -Wno-trigraphs -fpascal-strings -Os -Wreturn-type -Wunused-variable -isysroot $(PLAT)$(SDK) -isystem $(OCAMLDIR)/lib -DCAML_NAME_SPACE -fexceptions -miphoneos-version-min=4.2 -gdwarf-2 -D_FILE_OFFSET_BITS=64 -D_REENTRANT
+export CFLAGS = -x objective-c -std=c99 -Wno-trigraphs -fpascal-strings -O0 -Wreturn-type -Wunused-variable -isysroot $(PLAT)$(SDK) -isystem $(OCAMLDIR)/lib -DCAML_NAME_SPACE -fexceptions -miphoneos-version-min=4.2 -gdwarf-2 -D_FILE_OFFSET_BITS=64 -D_REENTRANT
 export OCAMLOPT = $(OCAMLFIND) ocamlopt
 export OCAMLC = $(OCAMLFIND) ocamlc
-export OCAMLMKLIB = /usr/local/ocaml/ios/3.12.1/bin/ocamlmklib
+export OCAMLMKLIB = $(OCAMLDIR)/bin/ocamlmklib
 LIB = native syntax

ocamllibs/extlib-1.5.2/Makefile.ios

@@ -1,27 +1,3 @@
-# Makefile contributed by Alain Frisch
-
-MODULES = \
- enum bitSet dynArray extArray extHashtbl extList extString global IO option \
- pMap std uChar uTF8 base64 unzip refList optParse dllist
-
-# the list is topologically sorted
-
-MLI = $(MODULES:=.mli)
-SRC = $(MLI) $(MODULES:=.ml) extLib.ml
-
 OCAMLFIND=ocamlfind -toolchain ios
-OCAMLOPT=$(OCAMLFIND) ocamlopt
-OCAMLC=$(OCAMLFIND) ocamlc
-
-all: 
-	$(OCAMLC) -a -o extLib.cma $(SRC)
-	$(OCAMLOPT)  -a -o extLib.cmxa $(SRC)
-
-install:
-	$(OCAMLFIND) install extlib META *.cma *.cmi $(MLI) $(wildcard *.cmxa) $(wildcard *.a)
-
-uninstall:
-	$(OCAMLFIND) remove extlib
 
-clean:
-	rm -f *.cmo *.cmx *.o *.cmi *.cma *.cmxa *.a
+include Makefile.in

ocamllibs/extlib-1.5.2/extHashtbl.mli

@@ -73,7 +73,7 @@ module Hashtbl :
 		functions. (note : functor support removed to avoid code
 		duplication). *)
 
-	val create : int -> ('a, 'b) t
+	val create : ?random:bool -> int -> ('a, 'b) t
 	val clear : ('a, 'b) t -> unit
 	val add : ('a, 'b) t -> 'a -> 'b -> unit
 	val copy : ('a, 'b) t -> ('a, 'b) t

ocamllibs/ojson/Makefile.in

@@ -2,9 +2,6 @@
 OCAMLOPT=$(OCAMLFIND) ocamlopt
 OCAMLC=$(OCAMLFIND) ocamlc
 
-install: 
-	$(OCAMLFIND) install ojson META ojson.cmi ojson.cma ojson.cmxa ojson.mli ojson.a
-
 byte:
 	$(OCAMLC) -c type.ml
 	$(OCAMLC) -c common.mli
@@ -27,6 +24,11 @@ native:
 	$(OCAMLOPT) -c ojson.ml
 	$(OCAMLOPT) -a type.cmx common.cmx read.cmx ojson.cmx -o ojson.cmxa
 
+install: 
+	$(OCAMLFIND) install ojson META ojson.cmi ojson.cma ojson.cmxa ojson.mli ojson.a
+
+uninstall:
+	$(OCAMLFIND) remove ojson
 
 clean:
 	rm -f *.cmo *.cmx *.cmxa *.a *.o *.cmi *.cma read.ml

ocamllibs/xmlm-1.0.2/Makefile

@@ -1,13 +1,3 @@
 
-OCAMLFIND=ocamlfind -toolchain ios
-OCAMLOPT=$(OCAMLFIND) ocamlopt
-
-all:
-	$(OCAMLOPT) -c src/xmlm.mli
-	$(OCAMLOPT) -c -annot -I src -I test -o src/xmlm.cmx src/xmlm.ml
-
-install:
-	$(OCAMLFIND) install xmlm src/META src/xmlm.mli src/xmlm.cmi src/xmlm.cmx src/xmlm.o src/xmlm.annot
-
-uninstall:
-	$(OCAMLFIND) remove xmlm
+OCAMLFIND = ocamlfind
+include Makefile.in

src/Atlas.ml

@@ -59,18 +59,18 @@ DEFINE RENDER_QUADS(program,transform,color,alpha) =
         | Some index ->
             try
               DynArray.insert children index child
-            with [ DynArray.Invalid_arg _ -> raise DisplayObject.Invalid_index ]
+            with [ DynArray.Invalid_arg _ -> raise (DisplayObject.Invalid_index (index,DynArray.length children))]
         ];
         Node.bounds child |> ignore; (* force calc bounds *)
         self#boundsChanged();
       );
 
-      method getChildAt idx = try DynArray.get children idx with [ DynArray.Invalid_arg _ -> raise DisplayObject.Invalid_index ];
+      method getChildAt idx = try DynArray.get children idx with [ DynArray.Invalid_arg _ -> raise (DisplayObject.Invalid_index (idx,DynArray.length children))];
 
       method childIndex node =
         try
           DynArray.index_of (fun c -> c == node) children
-        with [ Not_found -> raise DisplayObject.Invalid_index ];
+        with [ Not_found -> raise DisplayObject.Child_not_found ];
 
       method removeChild node =
         self#removeChildAt (self#childIndex node);
@@ -79,14 +79,14 @@ DEFINE RENDER_QUADS(program,transform,color,alpha) =
         try
           DynArray.delete children idx;
           self#boundsChanged();
-        with [ DynArray.Invalid_arg _ -> raise DisplayObject.Invalid_index ];
+        with [ DynArray.Invalid_arg _ -> raise (DisplayObject.Invalid_index (idx,DynArray.length children))];
 
       method updateChild idx child =
       (
         assert(child.Node.texture = texture);
         try
           DynArray.set children idx child;
-        with [ DynArray.Invalid_arg _ -> raise DisplayObject.Invalid_index ];
+        with [ DynArray.Invalid_arg _ -> raise (DisplayObject.Invalid_index (idx,DynArray.length children))];
         Node.bounds child |> ignore; (* force calc bounds *)
         self#boundsChanged();
       );
@@ -112,10 +112,10 @@ DEFINE RENDER_QUADS(program,transform,color,alpha) =
                 DynArray.delete children idx;
                 DynArray.insert children nidx child;
               )
-            with [ DynArray.Invalid_arg _ -> raise DisplayObject.Invalid_index ];
+            with [ DynArray.Invalid_arg _ -> raise (DisplayObject.Invalid_index (idx,DynArray.length children))];
             self#childrenDirty();
           )
-        else raise DisplayObject.Invalid_index;
+        else raise (DisplayObject.Invalid_index (nidx,DynArray.length children));
 
 (*       value mutable glowFilter = None; *)
 

src/BitmapFont.ml

@@ -138,9 +138,12 @@ value register xmlpath =
   let () = XmlParser.accept (`Dtd None) in
   let floats = XmlParser.floats in
   let parse_pages () = 
+    let () = debug "parse pages" in
     match XmlParser.next () with
     [ `El_start ((_,"Pages"),_) ->
+      let () = debug "this is pages" in
       let rec loop res = 
+        let () = debug "parse pages looop" in
         match XmlParser.parse_element "page" [ "file"] with
         [ Some [ file ] _ -> loop [ Texture.load ~with_suffix:False (Filename.concat dirname file) :: res ]
         | None -> res 

src/Debug.ml

@@ -40,7 +40,7 @@ value d_writer l =
     ]
   in
   fun addr s -> (Printf.eprintf "[DEBUG:%s(%s)] " l addr; prerr_endline s);
-value null_writer = (fun _ -> ());
+value null_writer = (fun _ _ -> ());
 END;
 
 

src/DisplayObject.ml

@@ -8,7 +8,8 @@ value ev_ENTER_FRAME = Ev.gen_id "ENTER_FRAME";
 
 type hidden 'a = 'a;
 
-exception Invalid_index;
+exception Invalid_index of (int*int);
+Printexc.register_printer (fun [ Invalid_index (c,n) -> Some (Printf.sprintf "DisplayObject.Invalid_index %d %d" c n) | _ -> None ]);
 exception Child_not_found;
 
 (* приходит массив точек, к ним применяется трасформация и в результате получаем min и максимальные координаты *)
@@ -774,7 +775,7 @@ class virtual container = (*{{{*)
           match children with
           [ None -> 
             match index with
-            [ Some idx when idx > 0 -> raise Invalid_index
+            [ Some idx when idx > 0 -> raise (Invalid_index (idx,0))
             | _ -> children := Some (Dllist.create child)
             ]
           | Some chldrn -> 
@@ -783,7 +784,7 @@ class virtual container = (*{{{*)
               | Some idx when idx > 0 && idx < numChildren -> Dllist.add (Dllist.skip chldrn (idx-1)) child
               | Some idx when idx = 0 -> children := Some (Dllist.prepend chldrn child)
               | Some idx when idx = numChildren -> Dllist.add (Dllist.prev chldrn) child
-              | _ -> raise Invalid_index
+              | Some idx -> raise (Invalid_index (idx,numChildren))
               ]
           ];
           numChildren := numChildren + 1;
@@ -804,17 +805,17 @@ class virtual container = (*{{{*)
 
     method getChildAt index = 
       match children with
-      [ None -> raise Invalid_index
+      [ None -> raise (Invalid_index (index,0))
       | Some children -> 
           match index >= 0 && index < numChildren with
           [ True -> Dllist.get (Dllist.skip children index)
-          | False -> raise Invalid_index
+          | False -> raise (Invalid_index (index,numChildren))
           ]
       ];
 
     method getLastChild =
       match children with
-      [ None -> raise Invalid_index
+      [ None -> raise (Invalid_index (1,0))
       | Some children -> Dllist.get (Dllist.prev children)
       ];
 
@@ -836,7 +837,7 @@ class virtual container = (*{{{*)
       match children with
       [ None -> raise Child_not_found
       | Some chldrn ->
-          if index >= numChildren || index < 0 then raise Invalid_index
+          if index >= numChildren || index < 0 then raise (Invalid_index (index,numChildren))
           else
             let () = debug:children "[%s] setChildIndex %s" self#name child#name in 
             let child = child#asDisplayObject in
@@ -951,13 +952,13 @@ class virtual container = (*{{{*)
 
     method removeChildAtIndex index : 'displayObject = 
       match children with
-      [ None -> raise Invalid_index
+      [ None -> raise (Invalid_index (index,0))
       | Some children -> 
         match index >= 0 && index < numChildren with
         [ True -> 
           let n = Dllist.skip children index in
           self#removeChild'' n
-        | False -> raise Invalid_index 
+        | False -> raise (Invalid_index (index,numChildren))
         ]
       ];
 

src/DisplayObject.mli

@@ -9,7 +9,7 @@ value ev_ENTER_FRAME: Ev.id;
 
 
 type hidden 'a;
-exception Invalid_index;
+exception Invalid_index of (int*int);
 exception Child_not_found;
 
 value dispatchEnterFrame: float -> unit;

src/LightCommon.ml

@@ -274,6 +274,7 @@ module MakeXmlParser(P:sig value path: string; value with_suffix: bool; end) = s
 (*   value get_attr name (tag_name,assoc) = try List.assoc name assoc with [ Not_found -> error "can't find attribute %s" name ]; *)
 
   value parse_element tag_name attr_names =
+    let () = debug "Parse element %s" tag_name in
     match Xmlm.input xmlinput with
     [ `El_start ((_,tname),attributes) when tname = tag_name ->
       let res = get_attributes tname attr_names attributes in

src/Lightning.ml

@@ -67,6 +67,15 @@ ENDIF;
 
 
 external memUsage: unit -> int = "ml_memUsage";
+type malinfo = 
+  {
+    malloc_total: int;
+    malloc_used: int;
+    malloc_free: int;
+  };
+
+external malinfo: unit -> malinfo = "ml_malinfo";
+
 external setMaxGC: int64 -> unit = "ml_setMaxGC";
 
 

src/Lightning.mli

@@ -6,6 +6,14 @@ value openURL : string -> unit;
 value sendEmail : string -> ~subject:string -> ?body:string -> unit -> unit;
 external memUsage: unit -> int = "ml_memUsage";
 external setMaxGC: int64 -> unit = "ml_setMaxGC";
+type malinfo = 
+  {
+    malloc_total: int;
+    malloc_used: int;
+    malloc_free: int;
+  };
+
+external malinfo: unit -> malinfo = "ml_malinfo";
 
 type remoteNotification = [= `RNBadge | `RNSound | `RNAlert ];
 value request_remote_notifications: list remoteNotification ->  (string -> unit) -> (string -> unit) -> unit;

src/Tween.ml

@@ -32,11 +32,11 @@ module Transitions = struct
 
 (*   value s = 1.70158; *)
 
-  value easeInBack ratio = (ratio ** 2.0) *. (2.70158 *. ratio -. 1.70158);
+  value easeInBack ratio = (ratio *. ratio) *. (2.70158 *. ratio -. 1.70158);
 
   value easeOutBack ratio =
     let invRatio = ratio -. 1.0 in
-    (invRatio ** 2.0) *. (2.70158 *. invRatio +. 1.70158) +. 1.0;
+    (invRatio *. invRatio) *. (2.70158 *. invRatio +. 1.70158) +. 1.0;
 
   value easeInOutBack ratio =
     if ratio < 0.5
@@ -80,20 +80,20 @@ module Transitions = struct
 (*     float p = 2.75f; *)
 (*     float l; *)
     if ratio < 0.363636363636
-    then 7.5625 *. (ratio ** 2.0)
+    then 7.5625 *. (ratio *. ratio)
     else
         if ratio < 0.727272727273 
         then
           let ratio = ratio -. 0.545454545455 in
-          7.5625 *. (ratio ** 2.0) +. 0.75
+          7.5625 *. (ratio *. ratio) +. 0.75
         else
           if ratio <  0.909090909091
           then
             let ratio = ratio -. 0.818181818182 in
-            7.5625 *. (ratio ** 2.0) +. 0.9375
+            7.5625 *. (ratio *. ratio) +. 0.9375
           else
             let ratio = ratio -. 0.954545454545 in
-            7.5625 *. (ratio ** 2.0) +. 0.984375
+            7.5625 *. (ratio *. ratio) +. 0.984375
   ;
 
   value easeInBounce ratio = 1.0 -. (easeOutBounce (1.0 -. ratio));
@@ -196,6 +196,7 @@ class c ?(delay=0.) ?(repeat=(-1)) ?(transition=`linear) ?(loop=`LoopNone) time
                     ];
                     let delta = action.endValue -. action.startValue in
                     let transitionValue = transition ratio in
+                    let () = debug "ratio: %f, transitionValue: %f" ratio transitionValue in
                     (*
                       match invertTransition with
                       [ True -> 1. -. (transition (1. -. ratio))

src/ios/LightViewController.m

@@ -22,14 +22,17 @@ @implementation LightViewController
 
 static LightViewController *instance = NULL;
 
-static void mlUncaughtException(const char* message) {
+static void mlUncaughtException(const char* exn, int bc, char** bv) {
+	// FIXME: address 
 	NSString * to = @"nanofarm@redspell.ru";
   NSString * subj = [NSString stringWithFormat:@"Сообщение об ошибке в игре '%@'", [[NSBundle mainBundle] objectForInfoDictionaryKey: @"CFBundleDisplayName"]];
 	UIDevice * dev = [UIDevice currentDevice];
 	NSString *appVersion = [[NSBundle mainBundle] objectForInfoDictionaryKey: @"CFBundleVersion"];
-	// Fixme - localization here
-	NSString * body = [NSString stringWithFormat:@"На моем %@ (iOS %@) ваше приложение (v%@) завершилось с ошибкой. Исправьте её как можно скорее. Спасибо!\n------------------------------------------------------\n%s", dev.model, dev.systemVersion, appVersion, message];
-	//NSString *email = [NSString stringWithFormat:@"mailto:%@?subject=%@&body=%@", to, subj, [NSString stringWithCString:message encoding:NSUTF8StringEncoding]];
+	// FIXME: localization here
+	NSString * body = [NSString stringWithFormat:@"На моем %@ (iOS %@) ваше приложение (v%@) завершилось с ошибкой. Исправьте её как можно скорее. Спасибо!\n------------------------------------------------------\n%s\n", dev.model, dev.systemVersion, appVersion, exn];
+	for (int i = 0; i < bc; i++) {
+		if (bv[i]) body = [body stringByAppendingString:[NSString stringWithCString:bv[i] encoding:NSASCIIStringEncoding]];
+	};
 	NSString *email = [NSString stringWithFormat:@"mailto:%@?subject=%@&body=%@", to, subj, body];
   email = [email stringByAddingPercentEscapesUsingEncoding:NSUTF8StringEncoding];
   [[UIApplication sharedApplication] openURL:[NSURL URLWithString:email]];