Permalink
Browse files

sdl net on curl with threads

  • Loading branch information...
serp256 committed Jul 21, 2011
1 parent 68f44be commit ab9ef856980db58adebde8775262cf2bac056496
View
@@ -1,4 +1,5 @@
include config.android
+META=META.android
include Makefile.in
INSTALL_OPTS = src/android/libpng/libpng.a
View
@@ -11,6 +11,7 @@ debug:
INSTALL_OPTS =
install: release
+ cp $(META) META
$(OCAMLFIND) install lightning META src/lightning.cmxa src/lightning.a src/liblightning.a src/*.cmi src/*.mli src/containers/*.cmi src/containers/*.mli src/syntax/pa_prop.cmo src/syntax/pa_debug.cmo $(INSTALL_OPTS)
uninstall:
View
@@ -1,3 +1,4 @@
include config.ios
+META=META.ios
include Makefile.in
View
@@ -1,3 +1,4 @@
include config.linux
+META=META.sdl
include Makefile.in
View
@@ -1,3 +1,4 @@
include config.macos
+META=META.sdl
include Makefile.in
View
@@ -56,7 +56,7 @@ module Make
[ False -> ()
| True ->
let open Touch in
- match touchEvent.Event.data with
+ match touchEvent.Ev.data with
[ `Touches touches ->
match touches with
[ [ touch :: _ ] ->
@@ -83,7 +83,7 @@ module Make
| TouchPhaseEnded when isDown ->
(
self#resetContents ();
- self#dispatchEvent (Event.create `TRIGGERED ());
+ self#dispatchEvent (Ev.create `TRIGGERED ());
)
| TouchPhaseCancelled when isDown -> self#resetContents ()
| _ -> ()
View
@@ -2,7 +2,7 @@ open Gl;
open LightCommon;
type eventType = [= `ADDED | `ADDED_TO_STAGE | `REMOVED | `REMOVED_FROM_STAGE | `ENTER_FRAME ];
-type eventData = [= Event.dataEmpty | `PassedTime of float ];
+type eventData = [= Ev.dataEmpty | `PassedTime of float ];
module type Param = sig
type evType = private [> eventType ];
@@ -66,13 +66,13 @@ DEFINE RENDER_WITH_MASK(call_render) =
class type dispObj =
object
- method dispatchEvent: ! 'a 'b. Event.t P.evType P.evData ( < .. > as 'a) ( < .. > as 'b) -> unit;
+ method dispatchEvent: ! 'a 'b. Ev.t P.evType P.evData ( < .. > as 'a) ( < .. > as 'b) -> unit;
end;
value onEnterFrameObjects : HSet.t dispObj = HSet.empty ();
value dispatchEnterFrame seconds =
- let enterFrameEvent = Event.create `ENTER_FRAME ~data:(`PassedTime seconds) () in
+ let enterFrameEvent = Ev.create `ENTER_FRAME ~data:(`PassedTime seconds) () in
HSet.iter (fun (obj:dispObj) -> obj#dispatchEvent enterFrameEvent) onEnterFrameObjects;
class virtual _c [ 'parent ] = (*{{{*)
@@ -82,7 +82,7 @@ class virtual _c [ 'parent ] = (*{{{*)
type 'parent =
<
- asDisplayObject: _c _; removeChild': _c _ -> unit; dispatchEvent': !'ct. Event.t P.evType P.evData 'displayObject 'ct -> unit;
+ asDisplayObject: _c _; removeChild': _c _ -> unit; dispatchEvent': !'ct. Ev.t P.evType P.evData 'displayObject 'ct -> unit;
name: string; transformationMatrixToSpace: !'space. option (<asDisplayObject: _c _; ..> as 'space) -> Matrix.t; stage: option 'parent; modified: unit -> unit; ..
>;
@@ -132,7 +132,7 @@ class virtual _c [ 'parent ] = (*{{{*)
method clearParent () = (parent := None;);
(* Events *)
- type 'event = Event.t P.evType P.evData 'displayObject 'self;
+ type 'event = Ev.t P.evType P.evData 'displayObject 'self;
type 'listener = 'event -> unit;
method private enterFrameListenerRemovedFromStage _ lid =
@@ -195,14 +195,14 @@ class virtual _c [ 'parent ] = (*{{{*)
];
);
- method dispatchEvent': !'ct. Event.t P.evType P.evData 'displayObject (< .. > as 'ct) -> unit = fun event -> (*{{{*)
+ method dispatchEvent': !'ct. Ev.t P.evType P.evData 'displayObject (< .. > as 'ct) -> unit = fun event -> (*{{{*)
(
try
- let l = List.assoc event.Event.etype listeners in
- let event = {(event) with Event.currentTarget = Some self} in
- ignore(List.for_all (fun (lid,l) -> (l event lid; event.Event.propagation = `StopImmediate)) l.EventDispatcher.lstnrs);
+ let l = List.assoc event.Ev.etype listeners in
+ let event = {(event) with Ev.currentTarget = Some self} in
+ ignore(List.for_all (fun (lid,l) -> (l event lid; event.Ev.propagation = `StopImmediate)) l.EventDispatcher.lstnrs);
with [ Not_found -> () ];
- match event.Event.bubbles && event.Event.propagation = `Propagate with
+ match event.Ev.bubbles && event.Ev.propagation = `Propagate with
[ True ->
match parent with
[ Some p -> p#dispatchEvent' event
@@ -213,8 +213,8 @@ class virtual _c [ 'parent ] = (*{{{*)
); (*}}}*)
(* всегда ставить таргет в себя и соответственно current_target *)
- method dispatchEvent: ! 't 'ct. Event.t P.evType P.evData ( < .. > as 't) (< .. > as 'ct) -> unit = fun event ->
- let event = {(event) with Event.target = Some self#asDisplayObject; currentTarget = None} in
+ method dispatchEvent: ! 't 'ct. Ev.t P.evType P.evData ( < .. > as 't) (< .. > as 'ct) -> unit = fun event ->
+ let event = {(event) with Ev.target = Some self#asDisplayObject; currentTarget = None} in
self#dispatchEvent' event;
value mutable scaleX = 1.0;
@@ -667,14 +667,14 @@ class virtual container = (*{{{*)
(* method dispatchEventOnChildren: !'ct. Event.t P.evType P.evData 'displayObject (< .. > as 'ct) -> unit = fun event -> (); *)
(* Сделать enum устойчивым к модификациям и переписать на полное использование енумов или щас ? *)
- method dispatchEventOnChildren: !'ct. Event.t P.evType P.evData 'displayObject (< .. > as 'ct) -> unit = fun event ->
+ method dispatchEventOnChildren: !'ct. Ev.t P.evType P.evData 'displayObject (< .. > as 'ct) -> unit = fun event ->
(* method dispatchEventOnChildren event = *)
(
self#dispatchEvent event;
Enum.iter begin fun (child:'displayObject) ->
match child#dcast with
[ `Container cont ->
- (cont :> < dispatchEventOnChildren: !'a. Event.t P.evType P.evData 'displayObject (< .. > as 'a) -> unit >)#dispatchEventOnChildren event
+ (cont :> < dispatchEventOnChildren: !'a. Ev.t P.evType P.evData 'displayObject (< .. > as 'a) -> unit >)#dispatchEventOnChildren event
| `Object obj -> obj#dispatchEvent event
]
end self#children;
@@ -737,14 +737,14 @@ class virtual container = (*{{{*)
numChildren := numChildren + 1;
child#setParent self#asDisplayObjectContainer;
child#modified();
- let event = Event.create `ADDED () in
+ let event = Ev.create `ADDED () in
child#dispatchEvent event;
match self#stage with
[ Some _ ->
- let event = Event.create `ADDED_TO_STAGE () in
+ let event = Ev.create `ADDED_TO_STAGE () in
match child#dcast with
[ `Container cont ->
- let cont = (cont :> < dispatchEventOnChildren: !'a. Event.t P.evType P.evData 'displayObject (< .. > as 'a) -> unit >) in
+ let cont = (cont :> < dispatchEventOnChildren: !'a. Ev.t P.evType P.evData 'displayObject (< .. > as 'a) -> unit >) in
cont#dispatchEventOnChildren event
| `Object _ -> child#dispatchEvent event
]
@@ -788,11 +788,11 @@ class virtual container = (*{{{*)
];
numChildren := numChildren - 1;
self#modified();
- let event = Event.create `REMOVED () in
+ let event = Ev.create `REMOVED () in
child#dispatchEvent event;
match self#stage with
[ Some _ ->
- let event = Event.create `REMOVED_FROM_STAGE () in
+ let event = Ev.create `REMOVED_FROM_STAGE () in
match child#dcast with
[ `Container cont -> cont#dispatchEventOnChildren event
| `Object _ -> child#dispatchEvent event
@@ -830,10 +830,10 @@ class virtual container = (*{{{*)
[ None -> ()
| Some chldrn ->
let evs =
- let event = Event.create `REMOVED () in
+ let event = Ev.create `REMOVED () in
match self#stage with
[ Some _ ->
- let sevent = Event.create `REMOVED_FROM_STAGE () in
+ let sevent = Ev.create `REMOVED_FROM_STAGE () in
fun (child:'displayObject) ->
(
child#dispatchEvent event;
View
@@ -1,6 +1,6 @@
type eventType = [= `ADDED | `ADDED_TO_STAGE | `REMOVED | `REMOVED_FROM_STAGE | `ENTER_FRAME ];
-type eventData = [= Event.dataEmpty | `PassedTime of float ];
+type eventData = [= Ev.dataEmpty | `PassedTime of float ];
module type Param = sig
type evType = private [> eventType ];
View
@@ -1,6 +1,6 @@
type eventType = [= `ADDED | `ADDED_TO_STAGE | `REMOVED | `REMOVED_FROM_STAGE | `ENTER_FRAME ];
-type eventData = [= Event.dataEmpty | `PassedTime of float ];
+type eventData = [= Ev.dataEmpty | `PassedTime of float ];
(* {{{
class type virtual _c' [ 'evType, 'evData, 'parent ] =
@@ -133,16 +133,16 @@ class virtual _c [ 'parent ] : (* _c' [evType,evData,'parent]; = *)
type 'displayObject = _c 'parent;
type 'parent =
<
- asDisplayObject: _c _; removeChild': _c _ -> unit; dispatchEvent': !'ct. Event.t evType evData _ (< .. > as 'ct) -> unit;
+ asDisplayObject: _c _; removeChild': _c _ -> unit; dispatchEvent': !'ct. Ev.t evType evData _ (< .. > as 'ct) -> unit;
name: string; transformationMatrixToSpace: !'space. option (<asDisplayObject: _c _; ..> as 'space) -> Matrix.t; stage: option 'parent; height: float; modified: unit -> unit; .. >;
(* inherit EventDispatcher.c [ 'event_type, 'event_data , _c _ _ _, _]; *)
- type 'event = Event.t evType evData 'displayObject 'self;
+ type 'event = Ev.t evType evData 'displayObject 'self;
type 'listener = 'event -> int -> unit;
method addEventListener: evType -> 'listener -> int;
method removeEventListener: evType -> int -> unit;
- method dispatchEvent: ! 't 'ct. Event.t evType evData ( < .. > as 't) (< .. > as 'ct) -> unit;
- method dispatchEvent': !'ct. Event.t evType evData 'displayObject (< .. > as 'ct) -> unit;
+ method dispatchEvent: ! 't 'ct. Ev.t evType evData ( < .. > as 't) (< .. > as 'ct) -> unit;
+ method dispatchEvent': !'ct. Ev.t evType evData 'displayObject (< .. > as 'ct) -> unit;
method hasEventListeners: evType -> bool;
value name: string;
@@ -234,7 +234,7 @@ class virtual container:
method removeChild': 'displayObject -> unit;
method containsChild': 'displayObject -> bool;
method removeChildren: unit -> unit;
- method dispatchEventOnChildren: !'ct. Event.t evType evData 'displayObject (< .. > as 'ct) -> unit;
+ method dispatchEventOnChildren: !'ct. Ev.t evType evData 'displayObject (< .. > as 'ct) -> unit;
method boundsInSpace: !'space. option (<asDisplayObject: 'displayObject; ..> as 'space) -> Rectangle.t;
method private render': option Rectangle.t -> unit;
method private hitTestPoint': Point.t -> bool -> option ('displayObject);
View
@@ -1,24 +0,0 @@
-
-type dataEmpty = [= `Empty ];
-
-type t 'etype 'data 'target 'currentTarget =
- {
- etype:'etype ;
- propagation:mutable [= `Propagate | `Stop | `StopImmediate ];
- bubbles:bool;
-(* eventPhase: [= `AT_TARGET | `BUBBLING_PHASE ]; *)
- target: option 'target;
- currentTarget: option 'currentTarget;
- data:'data;
- } constraint 'etype = [> ] constraint 'data = [> dataEmpty ] constraint 'target = < .. > constraint 'currentTarget = < .. >;
-
-
-
-value stopImmediatePropagation event = event.propagation := `StopImmediate;
-value stopPropagaion event =
- match event.propagation with
- [ `Propagate -> event.propagation := `Stop
- | _ -> ()
- ];
-
-value create etype ?(bubbles=False) ?(data=`Empty) () = { etype; propagation = `Propagate; bubbles; data; target = None; currentTarget = None };
View
@@ -1,20 +1,20 @@
-open Event;
+open Ev;
exception Listener_not_found;
-type listener 'eventType 'eventData 'target 'currentTarget = Event.t 'eventType 'eventData 'target 'currentTarget -> unit;
+type listener 'eventType 'eventData 'target 'currentTarget = Ev.t 'eventType 'eventData 'target 'currentTarget -> unit;
type listeners 'eventType 'eventData 'target 'currentTarget = list (int * (listener 'eventType 'eventData 'target 'currentTarget));
type lst 'eventType 'eventData 'target 'currentTarget =
{
counter: mutable int;
(* lstnrs: mutable list (int * (listener 'eventType 'eventData 'target 'currentTarget)); *)
- lstnrs: mutable list (int * (Event.t 'eventType 'eventData 'target 'currentTarget -> int -> unit));
+ lstnrs: mutable list (int * (Ev.t 'eventType 'eventData 'target 'currentTarget -> int -> unit));
};
value fire event lst =
try
- let l = List.assoc event.Event.etype lst in
- ignore(List.for_all (fun (lid,l) -> (l event lid; event.Event.propagation = `StopImmediate)) l.lstnrs);
+ let l = List.assoc event.Ev.etype lst in
+ ignore(List.for_all (fun (lid,l) -> (l event lid; event.Ev.propagation = `StopImmediate)) l.lstnrs);
True
with [ Not_found -> False ];
@@ -86,7 +86,7 @@ class type virtual c [ 'eventType,'eventData,'target,'currentTarget ] =
class virtual simple [ 'eventType , 'eventData , 'target ] =
object(self)
inherit base ['eventType,'eventData,'target,'target];
- type 'event = Event.t 'eventType 'eventData 'target 'target;
+ type 'event = Ev.t 'eventType 'eventData 'target 'target;
(* method private dispatchEvent' event = fire event listeners; *)
@@ -97,8 +97,8 @@ class virtual simple [ 'eventType , 'eventData , 'target ] =
let t = self#asEventTarget in
let event = {(event) with target = Some t; currentTarget = Some t } in
try
- let l = List.assoc event.Event.etype listeners in
- ignore(List.for_all (fun (lid,l) -> (l event lid; event.Event.propagation = `StopImmediate)) l.lstnrs);
+ let l = List.assoc event.Ev.etype listeners in
+ ignore(List.for_all (fun (lid,l) -> (l event lid; event.Ev.propagation = `StopImmediate)) l.lstnrs);
with [ Not_found -> () ];
end;
View
@@ -5,12 +5,12 @@ exception Listener_not_found;
type lst 'eventType 'eventData 'target 'currentTarget =
{
counter: mutable int;
- lstnrs: mutable list (int * (Event.t 'eventType 'eventData 'target 'currentTarget -> int -> unit));
+ lstnrs: mutable list (int * (Ev.t 'eventType 'eventData 'target 'currentTarget -> int -> unit));
};
class base [ 'eventType,'eventData,'target,'currentTarget ]:
object
- type 'listener = Event.t 'eventType 'eventData 'target 'currentTarget -> int -> unit;
+ type 'listener = Ev.t 'eventType 'eventData 'target 'currentTarget -> int -> unit;
value mutable listeners: list ('eventType * (lst 'eventType 'eventData 'target 'currentTarget));
method addEventListener: 'eventType -> 'listener -> int;
method removeEventListener: 'eventType -> int -> unit;
@@ -22,5 +22,5 @@ class virtual simple [ 'eventType , 'eventData , 'target ]:
object
inherit base ['eventType,'eventData,'target,'target];
method virtual private asEventTarget: 'target;
- method dispatchEvent: Event.t 'eventType 'eventData 'target 'target -> unit;
+ method dispatchEvent: Ev.t 'eventType 'eventData 'target 'target -> unit;
end;
View
@@ -16,7 +16,7 @@ module Make
method private onEnterFrame event _ =
- match event.Event.data with
+ match event.Ev.data with
[ `PassedTime dt ->
let osecs = int_of_float time in
(
View
@@ -12,7 +12,6 @@ GLPARAM =
MOBJS =
MLOBJSFLAGS =
MLFLAGS += -package extlib -I containers -I utils
-MLSOURCES =
MLDEPFLAGS =
release: lightning.cmxa syntax/pa_prop.cmo
@@ -49,11 +48,11 @@ else
else
gl = gl/2.1
MOBJS += sdl/sdl_stub.o sdl/sdl_image_stub.o
- MLSOURCES += sdl/sdl.ml sdl/sdl_image.ml sdl/sdl_run.ml
+ BMLSOURCES = sdl/sdl.ml sdl/sdl_image.ml
+ AMLSOURCES = sdl/sdl_run.ml
MLOBJSFLAGS = -I sdl
- MLDEPFLAGS += -I sdl sdl/*.ml sdl/*.mli
MLPPOPT += -DSDL
- MLFLAGS += -package curl
+ MLCOMPFLAGS += -package curl,threads -thread
ifeq ($(OS),macos)
LIBFLAGS = -cclib '-framework\ Cocoa' -cclib '-lSDL' -cclib '-lSDL_image' -cclib '-lSDLmain' -cclib '-framework\ OpenGL'
else
@@ -64,17 +63,16 @@ else
endif
-
MOBJS += $(gl)/gl_stub.o
+MLSOURCES = $(gl)/gl.ml $(BMLSOURCES) Debug.ml ProfTimer.ml WeakMemo.ml Dictionary.ml LightCommon.ml Ev.ml EventDispatcher.ml Point.ml Rectangle.ml Matrix.ml RenderSupport.ml \
+ DisplayObject.ml Sprite.ml Quad.ml GLTexture.ml Texture.ml TextureAtlas.ml Image.ml CompiledSprite.ml Touch.ml BitmapFont.ml TextField.ml FPS.ml Timers.ml Timer.ml \
+ Stage.ml Button.ml MovieClip.ml Tween.ml Sound.ml GameCenter.ml LocalStorage.ml URLLoader.ml $(AMLSOURCES) Lightning.ml
$(gl)/gl_stub.o: $(gl)/gl_stub.c
$(OCAMLOPT) -verbose -g $(if $(GLPARAM),-ccopt $(GLPARAM)) -ccopt '-o $(gl)/gl_stub.o' -c $(gl)/gl_stub.c
MLCONTAINERS = containers/MList.ml containers/HSet.ml containers/PriorityQueue.ml containers/WeakHashtbl.ml
MLUTILS = utils/UrlEncoding.ml
-MLSOURCES += $(gl)/gl.ml Debug.ml ProfTimer.ml WeakMemo.ml Dictionary.ml LightCommon.ml Event.ml EventDispatcher.ml Point.ml Rectangle.ml Matrix.ml RenderSupport.ml \
- DisplayObject.ml Sprite.ml Quad.ml GLTexture.ml Texture.ml TextureAtlas.ml Image.ml CompiledSprite.ml Touch.ml BitmapFont.ml TextField.ml FPS.ml Timers.ml Timer.ml \
- Stage.ml Button.ml MovieClip.ml Tween.ml Sound.ml GameCenter.ml LocalStorage.ml URLLoader.ml Lightning.ml
#XMLMFILES = TextureAtlas.ml BitmapFont.ml LightCommon.ml MovieClip.ml
@@ -84,6 +82,7 @@ MLCONTAINERSOBJS = $(MLCONTAINERS:.ml=.cmx)
MLUTILSOBJS = $(MLUTILS:.ml=.cmx)
MLOBJS = $(MLSOURCES:.ml=.cmx)
$(MLOBJS): MLFLAGS += -package xmlm -I $(gl) $(MLOBJSFLAGS)
+$(MLOBJS): Debug.cmx
$(MLOBJS) MLDepend.$(PLATFORM): syntax/pa_debug.cmo
$(MLOBJS) MLDepend.$(PLATFORM): MLPPOPT += syntax/pa_debug.cmo
@@ -95,7 +94,7 @@ lightning.cmxa: MLDepend.$(PLATFORM) $(MLCONTAINERSOBJS) $(MLUTILSOBJS) $(MOBJS)
MLDepend.$(PLATFORM):
$(OCAMLFIND) ocamldep $(MLFLAGS) -I containers $(MLCONTAINERS:.ml=.mli) $(MLCONTAINERS) > MLDepend.$(PLATFORM)
$(OCAMLFIND) ocamldep $(MLFLAGS) -I containers -I utils $(MLUTILS:.ml=.mli) $(MLUTILS) >> MLDepend.$(PLATFORM)
- $(OCAMLFIND) ocamldep $(MLFLAGS) -I $(gl) $(if $(MLPPOPT),$(patsubst %,-ppopt %,$(MLPPOPT))) *.mli $(MLSOURCES) >> MLDepend.$(PLATFORM)
+ $(OCAMLFIND) ocamldep $(MLFLAGS) -I $(gl) $(MLOBJSFLAGS) $(if $(MLPPOPT),$(patsubst %,-ppopt %,$(MLPPOPT))) *.mli $(MLSOURCES) >> MLDepend.$(PLATFORM)
doc:
Oops, something went wrong.

0 comments on commit ab9ef85

Please sign in to comment.