Working on new control

Kakadu · Oct 31, 2012 · 89e7614 · 89e7614
1 parent 5c019e9
commit 89e7614
Show file tree

Hide file tree

Showing 9 changed files with 86 additions and 5 deletions.
diff --git a/.gitignore b/.gitignore
@@ -17,3 +17,5 @@ myconfig.macos
 gen
 bin
 gen
+#emacs temporary
+*~
diff --git a/src/GLPrimitives.ml b/src/GLPrimitives.ml
@@ -0,0 +1,43 @@
+open LightCommon;
+
+class virtual base = 
+  object(self)
+    inherit DisplayObject.c as super;
+  end;
+
+class _c  =
+  object(self)
+    inherit base as super;
+
+    method !name = if name = ""  then Printf.sprintf "glprimitives%d" (Oo.id self) else name;
+    method setColor _ = ();
+    method color = `NoColor;
+    method filters = [];
+    method setFilters _ = ();
+    method boundsInSpace: 
+      !'space. (option (<asDisplayObject: DisplayObject.c; .. > as 'space)) -> Rectangle.t = 
+      fun _ ->  Rectangle.create 0. 0. 300. 300.
+    ;
+    method private render' ?alpha:(alpha') ~transform _ = 
+    (
+      debug "GLPrimitives._c.render";
+      Render.GLPrimitives.render ()
+    ); 
+end;
+
+class c  = 
+  object(self)
+    inherit _c ;
+    method ccast : [= `Image of c ] = `Image (self :> c);
+  end;
+
+value create () = new c;
+
+
+
+
+
+
+
+
+
diff --git a/src/Makefile b/src/Makefile
@@ -103,7 +103,7 @@ CFLAGS += -D$(PLATFORM)
 $(SYNTAX) Debug.cmx Debug.cmo: MLPPOPT := -D$(PLATFORM)
 
 MLSOURCES = $(BMLSOURCES) Hardware.ml LocalNotifications.ml Motion.ml ProfTimer.ml  WeakMemo.ml LightCommon.ml Ev.ml EventDispatcher.ml Point.ml Rectangle.ml Matrix.ml Render.ml Filters.ml \
-					DisplayObject.ml GLPrograms.ml Quad.ml Texture.ml  RenderTexture.ml Image.ml AtlasNode.ml TextureAtlas.ml Atlas.ml Clip.ml BitmapFont.ml Sprite.ml TLF.ml Timers.ml Timer.ml  LightLib.ml\
+					DisplayObject.ml GLPrograms.ml Quad.ml Texture.ml  RenderTexture.ml Image.ml GLPrimitives.ml AtlasNode.ml TextureAtlas.ml Atlas.ml Clip.ml BitmapFont.ml Sprite.ml TLF.ml Timers.ml Timer.ml  LightLib.ml\
 					Touch.ml Stage.ml Tween.ml Sound.ml GameCenter.ml URLLoader.ml KVStorage.ml Payment.ml $(AMLSOURCES) FB.ml Lightning.ml
 
 #Texture.cmo Texture.cmx: MLFLAGS += -package threads -thread

diff --git a/src/Render.ml b/src/Render.ml
@@ -138,3 +138,6 @@ module Image = struct
 
 end;
 
+module GLPrimitives = struct
+  external render: unit -> unit = "ml_glPrimitives_render" "noalloc";
+end;
diff --git a/src/Render.mli b/src/Render.mli
@@ -121,3 +121,8 @@ module Image :
   end
 ;
 
+module GLPrimitives :
+  sig
+    external render : unit -> unit = "ml_glPrimitives_render" "noalloc";
+  end
+;
diff --git a/src/render_stub.c b/src/render_stub.c
@@ -903,6 +903,15 @@ void ml_image_flip_tex_y(value image) {
 	tq->br.tex = tmp;
 }
 
+void ml_glPrimitives_render(value xs) {
+  PRINT_DEBUG("ml_glPrimitices_render");
+  glBegin(GL_LINES);
+  glColor3f(255.0,0,0);
+  glVertex2f(50,50);
+  glVertex2f(100,150);
+  glEnd();
+}
+
 void ml_image_render(value matrix, value program, value alpha, value image) {
 	//fprintf(stderr,"render image\n");
 	PRINT_DEBUG("RENDER IMAGE");

diff --git a/test/Makefile b/test/Makefile
@@ -1,4 +1,4 @@
-sdl:
+pc:
 	$(MAKE) -f Makefile.pc
 
 clean: 

diff --git a/test/Makefile.in b/test/Makefile.in
@@ -12,6 +12,7 @@ OAUTH = ../src/social/oauth/oauth.cma
 $(TARGET).byte: $(MLFILES) $(TARGET).cmo 
 	$(OCAMLC) -custom -verbose -o test.byte  -g  \
 	-I ../src ../src/lightning.cma $(OAUTH) $(SOCIAL) $(MLFILES) ../src/social/facebook/fbconnect.cma $(TARGET).cmo \
+	-ccopt -lglut \
 	-package bigarray,unix,extlib,xmlm,ojson -linkpkg
 
 example.cmo: $(MLFILES)

diff --git a/test/example.ml b/test/example.ml
@@ -1032,6 +1032,7 @@ value tweens (stage:Stage.c) =
     (* Stage.addTween tweenAlpha; *)
     (* tweenX#animate bt#prop'x 300.; *)
     tweenY#animate bt#prop'y 600.;
+    tweenY#animate bt#prop'x 600.;
     (* tweenAlpha#animate bt#prop'alpha 0.5; *)
     (* tweenX#setOnComplete (fun () -> Stage.removeg tweenX); *)
     (* tweenY#setOnComplete (fun () -> Stage.removeTween tweenY); *)
@@ -1369,19 +1370,36 @@ value texture_atlas (stage:Stage.c) =
   let image = Image.create (TextureAtlas.subTexture atlas "/background_levels/1.png") in
   stage#addChild image;
 
+value glPrimitives (stage: Stage.c) = 
+  let xxx = GLPrimitives.create () in
+  ( xxx#setX 0.
+  ; xxx#setY 0.
+  ; xxx#setWidth 400.
+  ; xxx#setHeight 400.
+  ; debug "Adding child"
+  ; stage#addChild xxx )
+;
 let stage width height = 
   object(self)
     inherit Stage.c width height as super;
     value bgColor = 0xCCCCCC;
     initializer begin
-      debug "%s" (Render.get_gl_extensions ());
-
+            glPrimitives self;
+(*          let delay = 0.1 in
+            let twin = Tween.create delay in
+            let () = twin#setOnComplete (fun () -> debug "completed" ) in
+            let duration = 1.0 in
+            twin#process duration |> ignore *)
+(*          tweens self;
+            udid self;*)
+(*    debug "%s" (Render.get_gl_extensions ()); *)
+(*
       let timer = Timer.create ~repeatCount:1 2. "PZIDA" in
         (
           ignore(timer#addEventListener Timer.ev_TIMER_COMPLETE (fun _ _ _ -> pvr self));
           timer#start ()
         );
-
+*)
     (* Sound.init (); *)
 
 (*         let channel1 = Sound.createChannel (Sound.load "achievement1.caf")