Permalink
Browse files

initial commit

  • Loading branch information...
0 parents commit d54460078b8248a2032948956bf9f0c29557baa6 @serp256 committed Apr 25, 2011
Showing with 25,568 additions and 0 deletions.
  1. +1 −0 LICENSE
  2. +4 −0 META
  3. +10 −0 Makefile
  4. +13 −0 Makefile.include
  5. +25 −0 Makefile.ios
  6. +14 −0 Makefile.macos
  7. +1 −0 README
  8. +230 −0 src/BitmapFont.ml
  9. +6 −0 src/BitmapFont.mli
  10. +127 −0 src/Button.ml
  11. +264 −0 src/CompiledSprite.ml
  12. +645 −0 src/DisplayObject.ml
  13. +102 −0 src/DisplayObject.mli
  14. +79 −0 src/DisplayObjectT.ml
  15. +20 −0 src/Event.ml
  16. +55 −0 src/EventDispatcher.ml
  17. +169 −0 src/GLTexture.ml
  18. +62 −0 src/Image.ml
  19. +14 −0 src/Image.mli
  20. +42 −0 src/LightCommon.ml
  21. +28 −0 src/Lightning.ml
  22. +77 −0 src/MLDepend
  23. +293 −0 src/MList.ml
  24. +55 −0 src/Makefile
  25. +59 −0 src/Matrix.ml
  26. +34 −0 src/OMakefile
  27. BIN src/OMakefile.omc
  28. +9 −0 src/ObjMemo.ml
  29. +28 −0 src/Point.ml
  30. +110 −0 src/Quad.ml
  31. +18 −0 src/Quad.mli
  32. +8 −0 src/Rectangle.ml
  33. +173 −0 src/RenderSupport.ml
  34. +9 −0 src/Sprite.ml
  35. +8 −0 src/Sprite.mli
  36. +109 −0 src/Stage.ml
  37. +150 −0 src/TextField.ml
  38. +17 −0 src/TextField.mli
  39. +119 −0 src/Texture.ml
  40. +15 −0 src/Texture.mli
  41. +56 −0 src/TextureAtlas.ml
  42. +65 −0 src/Touch.ml
  43. BIN src/gl/2.1/gl.cmi
  44. +3,997 −0 src/gl/2.1/gl.ml
  45. +2,952 −0 src/gl/2.1/gl.mli
  46. +7,875 −0 src/gl/2.1/gl_stub.c
  47. +890 −0 src/gl/es/gl.ml
  48. +782 −0 src/gl/es/gl.mli
  49. +1,309 −0 src/gl/es/gl_stub.c
  50. BIN src/gl/gl.cmo
  51. BIN src/ios/.mlwrapper_ios.m.swp
  52. +79 −0 src/ios/LightView.h
  53. +307 −0 src/ios/LightView.m
  54. +4 −0 src/ios/mlwrapper_ios.h
  55. +41 −0 src/ios/mlwrapper_ios.m
  56. +323 −0 src/ios/texture.m
  57. +103 −0 src/mlwrapper.c
  58. +32 −0 src/mlwrapper.h
  59. BIN src/sdl/.main.ml.swp
  60. +965 −0 src/sdl/sdl.ml
  61. +1,026 −0 src/sdl/sdl.mli
  62. +25 −0 src/sdl/sdl_image.ml
  63. +27 −0 src/sdl/sdl_image_stub.c
  64. BIN src/sdl/sdl_run.cmo
  65. +92 −0 src/sdl/sdl_run.ml
  66. +1,416 −0 src/sdl/sdl_stub.c
@@ -0,0 +1 @@
+he he he
@@ -0,0 +1,4 @@
+version="0.01"
+archive(byte)="lightning.cma"
+archive(native)="lightning.cmxa"
+requires="bigarray extlib xmlm"
@@ -0,0 +1,10 @@
+
+all:
+ $(MAKE) -C src
+
+install:
+ $(OCAMLFIND) install lightning META lightning/lightning.cmxa lightning/lightning.a lightning/*.cmi lightning/*.mli
+
+clean:
+ $(MAKE) -C src clean
+
@@ -0,0 +1,13 @@
+include /Users/serp/Projects/osparrow/Makefile.ios
+
+MLPPOPT =
+MLFLAGS = -package camlp4,camlp4.macro -syntax camlp4r -w +7+9 -g
+
+%.cmi: %.mli
+ $(OCAMLC) $(MLFLAGS) -c $<
+
+%.cmo: %.ml
+ $(OCAMLC) $(MLFLAGS) $(if $(MLPPOPT),$(patsubst %,-ppopt %,$(MLPPOPT))) -c $<
+
+%.cmx: %.ml
+ $(OCAMLOPT) $(MLFLAGS) $(if $(MLPPOPT),$(patsubst %,-ppopt %,$(MLPPOPT))) -c $<
@@ -0,0 +1,25 @@
+PLATFORM = ios
+PLAT = /Developer/Platforms/iPhoneOS.platform
+SDK = /Developer/SDKs/iPhoneOS4.3.sdk
+OCAMLDIR = /usr/local/ocaml/xarm/3.12.0
+OCAMLFIND = /usr/local/bin/ocamlfind -toolchain arm
+ARCH = -arch armv6
+OCAMLBINDIR = $(OCAMLDIR)/bin/
+CC = $(PLAT)/Developer/usr/bin/gcc-4.2 $(ARCH)
+CFLAGS = -x objective-c -std=c99 -Wno-trigraphs -fpascal-strings -O0 -DDEBUG -Wreturn-type -Wunused-variable -isysroot $(PLAT)$(SDK) -isystem $(OCAMLDIR)/lib -DCAML_NAME_SPACE -fexceptions -miphoneos-version-min=4.2 -gdwarf-2 -DDEBUG -D_FILE_OFFSET_BITS=64 -D_REENTRANT
+#CFLAGS = -std=c99 -DDEBUG -Wreturn-type -Wunused-variable -isysroot $(PLAT)$(SDK) -isystem $(OCAMLDIR)/lib -DCAML_NAME_SPACE -D_FILE_OFFSET_BITS=64 -D_REENTRANT
+# -mmacosx-version-min=10.6 -fobjc-abi-version=2 -fobjc-legacy-dispatch -D__IPHONE_OS_VERSION_MIN_REQUIRED=40200
+OCAMLOPT = $(OCAMLFIND) ocamlopt
+OCAMLC = $(OCAMLFIND) ocamlc
+OCAMLLIB = /usr/local/ocaml/xarm/3.12.0/bin/ocamlmklib
+MLFLAGS = -package camlp4,camlp4.macro -syntax camlp4r -w +7+9 -g
+
+
+%.cmi: %.mli
+ $(OCAMLC) $(MLFLAGS) -c $<
+
+%.cmo: %.ml
+ $(OCAMLC) $(MLFLAGS) -c $<
+
+%.cmx: %.ml
+ $(OCAMLOPT) $(MLFLAGS) -c $<
@@ -0,0 +1,14 @@
+#PLAT = /Developer/Platforms/MaxOSX.platform
+#SDK = /Developer/SDKs/iPhoneOS4.3.sdk
+SDK = /Developer/SDKs/MacOSX10.6.sdk
+OCAMLDIR = /usr/local/
+OCAMLFIND = /usr/local/bin/ocamlfind
+#ARCH = -arch armv6
+OCAMLBINDIR = $(OCAMLDIR)/bin/
+CC = gcc-4.2
+CFLAGS = -x objective-c -std=c99 -Wno-trigraphs -fpascal-strings -O0 -DDEBUG -Wreturn-type -Wunused-variable -isysroot $(SDK) -isystem $(OCAMLDIR)/lib/ocaml -DCAML_NAME_SPACE -fexceptions -gdwarf-2 -DDEBUG -D_FILE_OFFSET_BITS=64 -D_REENTRANT
+#CFLAGS = -std=c99 -DDEBUG -Wreturn-type -Wunused-variable -isysroot $(PLAT)$(SDK) -isystem $(OCAMLDIR)/lib -DCAML_NAME_SPACE -D_FILE_OFFSET_BITS=64 -D_REENTRANT
+# -mmacosx-version-min=10.6 -fobjc-abi-version=2 -fobjc-legacy-dispatch -D__IPHONE_OS_VERSION_MIN_REQUIRED=40200
+OCAMLOPT = $(OCAMLFIND) ocamlopt
+OCAMLC = $(OCAMLFIND) ocamlc
+OCAMLLIB = /usr/local/bin/ocamlmklib
@@ -0,0 +1 @@
+ha ha ha
@@ -0,0 +1,230 @@
+
+open LightCommon;
+
+
+type bc =
+ {
+ charID:int;
+ xOffset:float;
+ yOffset:float;
+ xAdvance: float;
+ charTexture: Texture.c;
+ };
+
+type t =
+ {
+ texture: Texture.c;
+ chars: Hashtbl.t int bc;
+ name: string;
+ size: float;
+ lineHeight: float;
+ };
+
+value fonts = Hashtbl.create 0;
+value exists name = Hashtbl.mem fonts name;
+exception Font_not_found of string;
+value get name =
+ try
+ Hashtbl.find fonts name
+ with [ Not_found -> raise (Font_not_found name) ];
+
+DEFINE CHAR_NEWLINE = 10;
+DEFINE CHAR_SPACE = 32;
+DEFINE CHAR_TAB = 9;
+
+value createText t ~width ~height ?(size=t.size) ~color ?(border=False) ?hAlign ?vAlign text =
+ let lineContainer = Sprite.create ()
+ and scale = size /. t.size in
+ let containerWidth = width /. scale
+ and containerHeight = height /. scale
+ in
+ (
+ lineContainer#setScale scale;
+ let lines = Queue.create () in
+ (
+ let strLength = String.length text
+ and lastWhiteSpace = ref None in
+ let rec add_line currentLine index =
+ (
+ Queue.add currentLine lines;
+ match index with
+ [ Some index ->
+ let nextLineY = currentLine#y +. t.lineHeight in
+ if nextLineY +. t.lineHeight <= containerHeight
+ then
+ let nextLine = Sprite.create () in
+ (
+ nextLine#setY nextLineY;
+ lastWhiteSpace.val := None;
+ add_char nextLine 0. index
+ )
+ else ()
+ | None -> ()
+ ]
+ )
+ and add_char currentLine (currentX:float) index =
+(* let () = Printf.printf "add char with index: %d\n%!" index in *)
+ if index < strLength
+ then
+ let code = UChar.code (UTF8.look text index) in
+ let bchar = try Hashtbl.find t.chars code with [ Not_found -> let () = Printf.eprintf "char %d not found\n%!" code in Hashtbl.find t.chars CHAR_SPACE ] in
+ if code = CHAR_NEWLINE
+ then
+ add_line currentLine (Some (UTF8.next text index))
+ else
+ if currentX +. bchar.xAdvance > containerWidth
+ then
+ let idx =
+ match !lastWhiteSpace with
+ [ Some idx ->
+ let removeIndex = idx in
+ let numCharsToRemove = currentLine#numChildren - removeIndex in
+ (
+(* let () = Printf.printf "lastWhiteSpace: numChildren: %d, removeIndex: %d, numCharsToRemove: %d\n%!" currentLine#numChildren removeIndex numCharsToRemove in *)
+ for i = 0 to numCharsToRemove - 1 do
+(* let () = Printf.printf "remove %d\n%!" currentLine#numChildren in *)
+ currentLine#removeChildAtIndex removeIndex
+ done;
+ UTF8.move text index ~-numCharsToRemove
+ )
+ | None -> index
+ ]
+ in
+ add_line currentLine (Some idx)
+ else
+ let bitmapChar = Image.create bchar.charTexture in
+ (
+ bitmapChar#setName (Printf.sprintf "letter: %d" index);
+ bitmapChar#setX (currentX +. bchar.xOffset);
+ bitmapChar#setY bchar.yOffset;
+ bitmapChar#setColor color;
+ currentLine#addChild bitmapChar;
+ if code = CHAR_SPACE then lastWhiteSpace.val := Some currentLine#numChildren else ();
+ add_char currentLine (currentX +. bchar.xAdvance) (UTF8.next text index)
+ )
+ else add_line currentLine None
+ in
+ add_char (Sprite.create()) 0. 0;
+ match hAlign with
+ [ Some ((`HAlignRight | `HAlignCenter) as halign) ->
+ Queue.iter begin fun line ->
+ (
+ let lastChar = line#getLastChild in
+ let lineWidth = lastChar#x +. lastChar#width in
+ let widthDiff = containerWidth -. lineWidth in
+ let () = Printf.printf "lastChar#x: %f, lastChar#width: %f, lineWidth: %f, widthDiff: %f\n%!" lastChar#x lastChar#width lineWidth widthDiff in
+ line#setX begin
+ match halign with
+ [ `HAlignRight -> widthDiff
+ | `HAlignCenter -> widthDiff /. 2.
+ ]
+ end;
+ lineContainer#addChild line
+ )
+ end lines
+ | _ -> Queue.iter lineContainer#addChild lines
+ ];
+ );
+ let outerContainer = CompiledSprite.create () in (* FIXME: must be compiled sprite *)
+ (
+ outerContainer#addChild lineContainer;
+ match vAlign with
+ [ Some ((`VAlignCenter | `VAlignBottom) as valign) ->
+ let contentHeight = (float lineContainer#numChildren) *. t.lineHeight *. scale in
+ let heightDiff = height -. contentHeight in
+ lineContainer#setY begin
+ match valign with
+ [ `VAlignBottom -> heightDiff
+ | `VAlignCenter -> heightDiff /. 2.
+ ]
+ end
+ | _ -> ()
+ ];
+ if border
+ then
+ let topBorder = Quad.create width 1.
+ and bottomBorder = Quad.create width 1.
+ and leftBorder = Quad.create 1. (height -. 2.)
+ and rightBorder = Quad.create 1. (height -. 2.)
+ in
+ (
+ topBorder#setColor color;
+ bottomBorder#setColor color;
+ leftBorder#setColor color;
+ rightBorder#setColor color;
+ bottomBorder#setY (height -. 1.);
+ leftBorder#setY 1.;
+ rightBorder#setY 1.;
+ rightBorder#setX (width -. 1.);
+ outerContainer#addChild topBorder;
+ outerContainer#addChild bottomBorder;
+ outerContainer#addChild leftBorder;
+ outerContainer#addChild rightBorder;
+ )
+ else ();
+ outerContainer;
+ )
+ );
+
+value register path = (*{{{*)
+ let path = resource_path path 1. in
+ let input = open_in path in
+ let xmlinput = Xmlm.make_input ~strip:True (`Channel input) in
+ let () = ignore(Xmlm.input xmlinput) in (* ignore dtd *)
+ let parse_info () =
+ let res = parse_xml_element xmlinput "info" [ "face"; "size"] in
+ (List.assoc "face" res,float_of_string (List.assoc "size" res))
+ and parse_common () =
+ let res = parse_xml_element xmlinput "common" [ "lineHeight"] in
+ float_of_string ( List.assoc "lineHeight" res)
+ and parse_page () =
+ match Xmlm.input xmlinput with
+ [ `El_start ((_,"pages"),_) ->
+ let res = parse_xml_element xmlinput "page" [ "file"] in
+ (
+ match Xmlm.input xmlinput with
+ [ `El_end -> List.assoc "file" res
+ | _ -> failwith "Bitmap fonts with multiple pages are not supported"
+ ]
+ )
+ | _ -> assert False
+ ]
+ and parse_chars texture =
+ match Xmlm.input xmlinput with
+ [ `El_start ((_,"chars"),attributes) ->
+ let count = get_xml_attribute "count" attributes in
+ let chars = Hashtbl.create (int_of_string count) in
+ let rec loop () =
+ match Xmlm.peek xmlinput with
+ [ `El_end -> (ignore(Xmlm.input xmlinput); chars)
+ | _ ->
+ (
+ let res = parse_xml_element xmlinput "char" ["id";"x";"y";"width";"height";"xoffset";"yoffset";"xadvance"] in
+ let charID = int_of_string (List.assoc "id" res) in
+ let get_float x = float_of_string (List.assoc x res) in
+ let bc =
+ let region = Rectangle.create (get_float "x") (get_float "y") (get_float "width") (get_float "height") in
+ let charTexture = Texture.createSubTexture region texture in
+ { charID ; xOffset = get_float "xoffset"; yOffset = get_float "yoffset"; xAdvance = get_float "xadvance"; charTexture }
+ in
+ Hashtbl.add chars charID bc;
+ loop ()
+ )
+ ]
+ in
+ loop ()
+ | _ -> assert False
+ ]
+ in
+ match Xmlm.input xmlinput with
+ [ `El_start ((_,"font"),_) ->
+ let (name,size) = parse_info () in
+ let lineHeight = parse_common () in
+ let imgFile = parse_page () in
+ let texture = Texture.createFromFile imgFile in
+ let chars = parse_chars texture in
+ let bf = { texture; chars; name; size; lineHeight } in
+ let () = Printf.printf "register font %s\n%!" name in
+ Hashtbl.add fonts name bf
+ | _ -> assert False
+ ];(*}}}*)
@@ -0,0 +1,6 @@
+
+type t;
+value register: string -> unit;
+value exists: string -> bool;
+value get: string -> t;
+value createText: t -> ~width:float -> ~height:float -> ?size:float -> ~color:int -> ?border:bool -> ?hAlign:LightCommon.halign -> ?vAlign:LightCommon.valign -> string -> CompiledSprite.c _ _;
Oops, something went wrong.

0 comments on commit d544600

Please sign in to comment.