Página Principal Explorar Ajuda
Iniciar Sessão
haxe
/
HaxeFoundation.haxe
mirror de https://github.com/HaxeFoundation/haxe.git
2
0
Fork 0
Ficheiros Problemas 0 Wiki
Ver Fonte

[libs] delete things randomly

Simon Krajewski há 1 ano atrás
pai
58e9e5245b
commit
dec37b31a0
18 ficheiros alterados com 2 adições e 2826 exclusões
Visão Dividida Mostrar Estatísticas Diff
  1. 1 2
      libs/Makefile
  2. 0 66
      libs/ocamake/ocamake.dsp
  3. 0 29
      libs/ocamake/ocamake.dsw
  4. 0 94
      libs/ocamake/ocamake.html
  5. 0 661
      libs/ocamake/ocamake.ml
  6. 0 21
      libs/swflib/swflib.sln
  7. 0 80
      libs/swflib/swflib.vcproj
  8. 0 31
      libs/ttflib/Makefile
  9. 0 14
      libs/ttflib/dune
  10. 0 139
      libs/ttflib/main.ml
  11. 0 50
      libs/ttflib/tTFCanvasWriter.ml
  12. 0 360
      libs/ttflib/tTFData.ml
  13. 0 49
      libs/ttflib/tTFJsonWriter.ml
  14. 0 688
      libs/ttflib/tTFParser.ml
  15. 0 211
      libs/ttflib/tTFSwfWriter.ml
  16. 0 275
      libs/ttflib/tTFTools.ml
  17. 1 1
      src/dune
  18. 0 55
      src/generators/genswf.ml

+ 1 - 2
libs/Makefile
Ver Ficheiro 

@@ -1,7 +1,7 @@
 
 OCAMLOPT = ocamlopt
 
 OCAMLC = ocamlc
 
 TARGET_FLAG = all
 
-LIBS=extlib-leftovers extc neko javalib ilib swflib ttflib objsize pcre2 ziplib
 
+LIBS=extlib-leftovers extc neko javalib ilib swflib objsize pcre2 ziplib
 
 
 all: $(LIBS)
 
 $(LIBS):
 
@@ -14,7 +14,6 @@ clean:
 
 	$(MAKE) -C javalib clean
 
 	$(MAKE) -C ilib clean
 
 	$(MAKE) -C swflib clean
 
-	$(MAKE) -C ttflib clean
 
 	$(MAKE) -C objsize clean
 
 	$(MAKE) -C pcre2 clean
 
 	$(MAKE) -C ziplib clean

+ 0 - 66
libs/ocamake/ocamake.dsp
Ver Ficheiro 

@@ -1,66 +0,0 @@
 
-# Microsoft Developer Studio Project File - Name="ocamake" - Package Owner=<4>
 
-# Microsoft Developer Studio Generated Build File, Format Version 6.00
 
-# ** DO NOT EDIT **
 
-
 
-# TARGTYPE "Win32 (x86) External Target" 0x0106
 
-
 
-CFG=ocamake - Win32 Native code
 
-!MESSAGE This is not a valid makefile. To build this project using NMAKE,
 
-!MESSAGE use the Export Makefile command and run
 
-!MESSAGE 
-!MESSAGE NMAKE /f "ocamake.mak".
 
-!MESSAGE 
-!MESSAGE You can specify a configuration when running NMAKE
 
-!MESSAGE by defining the macro CFG on the command line. For example:
 
-!MESSAGE 
-!MESSAGE NMAKE /f "ocamake.mak" CFG="ocamake - Win32 Native code"
 
-!MESSAGE 
-!MESSAGE Possible choices for configuration are:
 
-!MESSAGE 
-!MESSAGE "ocamake - Win32 Native code" (based on "Win32 (x86) External Target")
 
-!MESSAGE 
-
 
-# Begin Project
 
-# PROP AllowPerConfigDependencies 0
 
-# PROP Scc_ProjName ""
 
-# PROP Scc_LocalPath ""
 
-# PROP BASE Use_MFC 0
 
-# PROP BASE Use_Debug_Libraries 0
 
-# PROP BASE Output_Dir ""
 
-# PROP BASE Intermediate_Dir ""
 
-# PROP BASE Cmd_Line "ocamake -opt ocamake.dsp -o ocamake.exe"
 
-# PROP BASE Rebuild_Opt "-all"
 
-# PROP BASE Target_File "ocamake_opt.exe"
 
-# PROP BASE Bsc_Name ""
 
-# PROP BASE Target_Dir ""
 
-# PROP Use_MFC 0
 
-# PROP Use_Debug_Libraries 0
 
-# PROP Output_Dir ""
 
-# PROP Intermediate_Dir ""
 
-# PROP Cmd_Line "ocamake str.cmxa unix.cmxa -opt ocamake.dsp -o ocadbg.exe"
 
-# PROP Rebuild_Opt "-all"
 
-# PROP Target_File "ocadbg.exe"
 
-# PROP Bsc_Name ""
 
-# PROP Target_Dir ""
 
-# Begin Target
 
-
 
-# Name "ocamake - Win32 Native code"
 
-
 
-!IF  "$(CFG)" == "ocamake - Win32 Native code"
 
-
 
-!ENDIF 
-
 
-# Begin Group "ML Files"
 
-
 
-# PROP Default_Filter "ml;mly;mll"
 
-# Begin Source File
 
-
 
-SOURCE=.\ocamake.ml
 
-# End Source File
 
-# End Group
 
-# Begin Group "MLI Files"
 
-
 
-# PROP Default_Filter "mli"
 
-# End Group
 
-# End Target
 
-# End Project

+ 0 - 29
libs/ocamake/ocamake.dsw
Ver Ficheiro 

@@ -1,29 +0,0 @@
 
-Microsoft Developer Studio Workspace File, Format Version 6.00
 
-# WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE!
 
-
 
-###############################################################################
 
-
 
-Project: "ocamake"=.\ocamake.dsp - Package Owner=<4>
 
-
 
-Package=<5>
 
-{{{
 
-}}}
 
-
 
-Package=<4>
 
-{{{
 
-}}}
 
-
 
-###############################################################################
 
-
 
-Global:
 
-
 
-Package=<5>
 
-{{{
 
-}}}
 
-
 
-Package=<3>
 
-{{{
 
-}}}
 
-
 
-###############################################################################
 
-

+ 0 - 94
libs/ocamake/ocamake.html
Ver Ficheiro 

@@ -1,94 +0,0 @@
 
-<html>
 
-<body bgcolor="#ffffff" link="Black" vlink="Black">
 
-<center><b><font color="#000099" size="+2">OCamake</font></b></center>
 
-<br>
 
-<font color="#777777">
 
-	OCamake - Copyright (c)2002-2003 Nicolas Cannasse & Motion Twin.<br>
 
-	The last version of this software can be found at : <a href="http://tech.motion-twin.com">http://tech.motion-twin.com</a><br><br>
 
-	This software is provided "AS IS" without any warranty of any kind, merchantability or fitness for a particular purpose. You should use it at your own risks, as the author and his company won't be responsible for any problem that the usage of this software could raise.
 
-</font>
 
-<br>
 
-<br>
 
-
 
-<ul>
 
-
 
-<li><b><font color="#000099">Introduction:</font></b><br>
 
-<br>
 
-OCamake is an automatic compiler for the Objective Caml language. It removes pain from the user which does not need anymore to write a Makefile. OCamake can work either as an application which compile your program or as a Makefile generator (using the <code>-mak</code> flag). OCamake has also special features for integration under Microsoft Visual Studio.
 
-<br>
 
-<br>
 
-<li><b><font color="#000099">Installation:</font></b><br>
 
-<br>
 
-OCamake is a source-only distribution, so you need to compile it first. Type the following command-line:<br>
 
-&nbsp;&nbsp;<code>ocamlc unix.cma str.cma ocamake.ml -o ocamake.exe</code><br>
 
-This should produce a file "<code>ocamake.exe</code>". Copy this file in your <code>ocaml/bin</code> directory.<br>
 
-<br>
 
-<li><b><font color="#000099">Usage:</font></b><br>
 
-<br>
 
-To compile your project, simply call OCamake with the files you want to compile:<br>
 
-&nbsp;&nbsp;<code>ocamake *.ml *.mli</code><br>
 
-<br>
 
-To remove all intermediate files that have been produced by the compiler :<br>
 
-&nbsp;&nbsp;<code>ocamake -clean *.ml *.mli</code><br>
 
-<br>
 
-To generate a Makefile:<br>
 
-&nbsp;&nbsp;<code>ocamake -mak *.ml *.mli</code><br>
 
-&nbsp;&nbsp;<code>make all</code><br>
 
-&nbsp;&nbsp;<code>...</code><br>
 
-&nbsp;&nbsp;<code>make clean</code><br>
 
-<br>
 
-(Windows users can use <code>nmake</code> instead of make and should use <code>nmake wclean</code> to remove intermediate files)
 
-<br>
 
-<br>
 
-<li><b><font color="#000099">Features:</font></b><br>
 
-<br>
 
-OCamake works with the following files :
 
-<ul>
 
-	<li><code>ml, mli</code> : theses files are added to the list of files to build
 
-	<li><code>cmo, cmx, cma, cmxa, dll, so, lib, a, o, obj</code> : theses files are added to the library list
 
-	<li><code>mll, mly</code> : theses files are compiled using <code>ocamllex</code> and <code>ocamlyacc</code>, and their result are added to the list of files to build.
 
-	<li><code>dsp, vcproj</code> (Visual Studio Project) : all the files included in the project are added to the ocamake file list.
 
-</ul>
 
-<br>
 
-Once the final file list is made, OCamake run <code>ocamldep</code> to build module dependencies tree, and then build and link the tree in the good order (for more information on the algorithm used, see sources).
 
-Only modified sources files or files with one dependency modified are rebuilt.<br>
 
-<br>
 
-If one <code>dsp</code> file has been found or if the <code>-epp</code> flag has been set, then all compilation errors are processed by OCamake to transform them into a Visual Studio compatible format.<br>
 
-If one <code>dsp</code> file has been found or if the <code>-cpp</code> flag has been set, the character ranges in Ocaml errors are replaced by the corresponding expression found in the source file.
 
-<br>
 
-<br>
 
-<li><b><font color="#000099">Options:</font></b><br>
 
-<br>
 
-The following command-line options are available :
 
-<ul>
 
-	<li><code>-clean</code> : delete all the intermediate and ouput files for the target build.
 
-	<li><code>-mak</code> : generate a <code>Makefile</code> for this project (<i>still experimental</i>).
 
-	<li><code>-opt</code> : turn on native compilation.
 
-	<li><code>-a</code> : build a library (<code>cma or cmxa</code>).
 
-	<li><code>-o &lt;output&gt;</code> : set the output file for the project.
 
-	<li><code>-all</code> : rebuild the entire project.
 
-	<li><code>-cpp</code> : convert characters range in errors to file expression.
 
-	<li><code>-epp</code> : use MSVC error messages format.
 
-	<li><code>-g</code> : compile and link in debug mode.
 
-	<li><code>-pp &lt;command&gt;</code> : pipe source through preprocessor.
 
-	<li><code>-cp &lt;flag&gt;</code> : add this flag to the compiler command line paramaters.
 
-	<li><code>-lp &lt;flag&gt;</code> : add this flag to the linker command line paramaters.
 
-	<li><code>-I &lt;path&gt;</code> : add the path to the list of include directories.
 
-	<li><code>-n &lt;file&gt;</code> : remove that file from the file list : this can be useful when you want to have all the files but one (<code>ocamake -n myfile.ml *.ml *.mli</code>).
 
-	<li><code>-v</code> : verbose mode - this print all the commands that ocamake is running in order to build the project.
 
-	<li><code>-P &lt;file&gt;</code> : add priority to a given file when having cycle between modules.
 
-</ul>
 
-<br>
 
-<li><b><font color="#000099">Licence:</font></b><br>
 
-<br>
 
-The full source code of OCamake is included, so you can modify, use, and redistribute it as you want for any usage conform to the licence. This code is under the LGPL (GNU Lesser General Public Licence), you can get more information on www.gnu.org.<br>
 
-<br>
 
-<li><b><font color="#000099">Author:</font></b><br>
 
-<br>
 
-Nicolas Cannasse <a href="mailto:[email protected]">[email protected]</a><br>
 
-Website : <a href="http://tech.motion-twin.com">http://tech.motion-twin.com</a><br>
 
-Thanks to <a href="http://www.lexifi.com">Lexifi</a>.
 
-<br>
 
-<br>
 
-</body>
 
-</html>

+ 0 - 661
libs/ocamake/ocamake.ml
Ver Ficheiro 

@@ -1,661 +0,0 @@
 
-(* ************************************************************************ *)
 
-(*                                                                          *)
 
-(* OCAMAKE - OCaml Automatic compilation                                    *)
 
-(*      (c)2002 Nicolas Cannasse                                            *)
 
-(*      (c)2002 Motion-Twin                                                 *)
 
-(*                                                                          *)
 
-(* Last version : http://tech.motion-twin.com                               *)
 
-(*                                                                          *)
 
-(* ************************************************************************ *)
 
-open Unix
 
-open Printf
 
-open Arg
 
-
 
-type compile_mode =
 
-	| CM_DEFAULT
 
-	| CM_BYTE
 
-	| CM_OPT
 
-
 
-type file_ext =
 
-	| ML | MLI | MLL | MLY
 
-	| CMO | CMX | CMA | CMXA
 
-	| DLL | SO | EXE | LIB
 
-	| CMI | O | OBJ | A
 
-
 
-type file = {
 
-	name : string;
 
-	ext : file_ext;
 
-	target : string;
 
-	deps : string list;
 
-}
 
-
 
-(* ************************************************************************ *)
 
-(* GLOBALS *)
 
-
 
-let verbose = ref false (* print command calls in verbose mode *)
 
-let project_name = ref None (* for VC++ DSP *)
 
-let error_process = ref false (* VC++ error message processing *)
 
-let chars_process = ref false (* replace chars range in errors by file data *)
 
-
 
-(* ************************************************************************ *)
 
-(* USEFUL FUNCTIONS *)
 
-
 
-let if_some f opt def =
 
-	match opt with
 
-	| None -> def
 
-	| Some v -> f v
 
-
 
-let print str = print_endline str; flush Pervasives.stdout
 
-
 
-let (???) file =
 
-	failwith ("Don't know what to do with file " ^ file)
 
-
 
-let str_suffix = function
 
-	| ML -> "ml" | MLI -> "mli" | MLL -> "mll" | MLY -> "mly" | CMO -> "cmo"
 
-	| CMX -> "cmx" | CMA -> "cma" | CMXA -> "cmxa" | DLL -> "dll" | SO -> "so"
 
-	| EXE -> "exe" | CMI -> "cmi" | O -> "o" | A -> "a" | OBJ -> "obj"
 
-	| LIB -> "lib"
 
-
 
-let unescape file =
 
-	let l = String.length file in
 
-	if l >= 2 && file.[0] = '"' && file.[l-1] = '"' then String.sub file 1 (l-2) else file
 
-
 
-let extension file =
 
-	let rsplit_char str ch =
 
-		let p = String.rindex str ch in
 
-		let len = String.length str in
 
-		(String.sub str 0 p, String.sub str (p + 1) (len - p - 1))	
-	in
 
-	let file = unescape file in
 
-	let s = try snd(rsplit_char file '.') with Not_found -> "" in
 
-	String.uppercase s
 
-
 
-let (+!) file suff =
 
-	let base = Filename.chop_extension file in
 
-	base ^ "." ^ str_suffix suff
 
-
 
-let filter_all_in func ic =
 
-	let rec treat acc =
 
-	try
 
-		match func (input_line ic) with
 
-		| None -> treat acc
 
-		| Some data -> treat (data :: acc)
 
-	with
 
-		End_of_file -> close_in ic; acc
 
-	in
 
-	List.rev (treat [])
 
-
 
-let rec remove_duplicates = function
 
-	| [] -> []
 
-	| item :: q when List.exists ((=) item) q -> remove_duplicates q
 
-	| item :: q -> item :: remove_duplicates q
 
-
 
-let file_time fname =
 
-	try (Unix.stat fname).st_mtime with Unix_error _ -> 0.
 
-
 
-let flatten = String.concat " "
 
-
 
-let escape str =
 
-	try
 
-		ignore(String.index str ' ');
 
-		"\"" ^ str ^ "\"";
 
-	with Not_found -> str
 
-
 
-let delete_file file =
 
-	try Sys.remove file with Sys_error _ -> ()
 
-
 
-let check_existence (ext,name) =
 
-	match ext with
 
-	| ML | MLI ->
 
-		if not (Sys.file_exists name) then
 
-			failwith ("No such file : "^(escape name))
 
-	| _ -> ()
 
-		(* Others files can be found in Ocaml stdlib or
 
-		   user -I paths *)
 
-
 
-exception Found_pos of int
 
-
 
-let print_errors output msg =
 
-	let split str sep =
 
-		let find_sub str sub =
 
-			let len = String.length sub in
 
-			try
 
-				for i = 0 to String.length str - len do
 
-					if String.sub str i len = sub then raise (Found_pos i);
 
-				done;
 
-				raise Not_found
 
-			with Found_pos i -> i 
-		in
 
-		let p = find_sub str sep in
 
-		let len = String.length sep in
 
-		let slen = String.length str in
 
-		(String.sub str 0 p, String.sub str (p + len) (slen - p - len))
 
-	in
 
-	let process_chars file chars line =
 
-		let cmin, cmax = split chars "-" in
 
-		let cmin, cmax = int_of_string cmin, int_of_string cmax in
 
-		if cmax > cmin then begin
 
-			let f = open_in file in
 
-			for i = 1 to line-1 do ignore(input_line f) done;
 
-			seek_in f ((pos_in f)+cmin);
 
-			let s = String.create (cmax - cmin) in
 
-			ignore(input f s 0 (cmax - cmin));
 
-			prerr_endline (try
 
-					(String.sub s 0 (String.index s '\n'))^"..."
 
-				with
 
-					Not_found -> s);
 
-		end
 
-	in
 
-	let printer =
 
-		(match !error_process , !chars_process with
 
-		| true , _ -> (function line ->
 
-			try
 
-				let data, chars = split line ", characters " in
 
-				let data, lnumber = split data "\", line " in
 
-				let _, file = split data "File \"" in
 
-				prerr_string (file ^ "(" ^ lnumber ^ ") : ");
 
-				let chars, _ = split chars ":" in
 
-				if !chars_process then
 
-					(try process_chars file chars (int_of_string lnumber) with _ -> raise Not_found)
 
- 			with
 
-				Not_found ->
 
-					prerr_endline line)
 
-		| false , true -> (function line ->
 
-			try
 
-				let edata, chars = split line ", characters " in
 
-				let data, lnumber = split edata "\", line " in
 
-				let _, file = split data "File \"" in
 
-				let chars, _ = split chars ":" in
 
-				prerr_string (edata^" : ");
 
-				if !chars_process then
 
-					process_chars file chars (int_of_string lnumber);
 
- 			with
 
-				Not_found ->
 
-					prerr_endline line)
 
-
 
-		| false , false ->
 
-		      prerr_endline)
 
-	in
 
-	List.iter printer output;
 
-	failwith msg
 
-
 
-let exec ?(stdout=false) ?(outfirst=false) cmd errmsg =
 
-	if !verbose then print cmd;
 
-	let pout, pin, perr = open_process_full cmd (Unix.environment()) in
 
-	let read = filter_all_in (fun s -> Some s) in
 
-	let data, edata = 
-	(* this is made to prevent the program lock when one
 
-	   buffer is full and the process is waiting for us
 
-	   to read it before exiting... while we're reading
 
-	   the other output buffer ! *)
 
-	(if outfirst then
 
-		let d = read pout in
 
-		let ed = read perr in
 
-		d,ed
 
-	else	
-		let ed = read perr in
 
-		let d = read pout in
 
-		d,ed) in
 
-	match close_process_full (pout, pin, perr) with
 
-	| WEXITED 0 -> data,edata
 
-	| WEXITED exitcode -> print_errors (if stdout then edata @ data else edata) errmsg
 
-	| _ -> failwith "Build aborted by signal"
 
-
 
-(* ************************************************************************ *)
 
-(* DEPENDENCIES *)
 
-
 
-let line_regexp = Str.regexp "^\\([0-9A-Za-z:_\\./\\\\-]+\\.cm[oi]\\):\\( .*\\)$"
 
-let dep_regexp = Str.regexp " \\([0-9A-Za-z:_\\./\\\\-]+\\.cm[oi]\\)"
 
-
 
-let build_graph opt paramlist files =
 
-	let srcfiles = List.filter (fun (e,_) ->
 
-		match e with
 
-		| ML | MLI -> true
 
-		| _ -> false) files in
 
-	let get_name (_,f) = escape f in
 
-	let file_names = flatten (List.map get_name srcfiles) in
 
-	let params = flatten paramlist in
 
-	let command = sprintf "ocamldep %s %s" params file_names in	
-	let output,_ = exec command "Failed to make dependencies" ~outfirst:true in
 
-	let data = String.concat "\n" output in	
-	let data = Str.global_replace (Str.regexp "\\\\\r\n") "" data in (* win *)
 
-	let data = Str.global_replace (Str.regexp "\\\\\n") "" data in (* unix *)		
-	let rec get_deps data p =
 
-		try
 
-			let newp = Str.search_forward dep_regexp data p in
 
-			let file = Str.matched_group 1 data in
 
-			if opt && extension file = "CMO" then 
-				(file +! CMX)::(get_deps data (newp+1))
 
-			else
 
-				file::(get_deps data (newp+1))
 
-		with
 
-			Not_found -> []
 
-	in
 
-	let rec get_lines p =		
-		try
 
-			let newp = Str.search_forward line_regexp data p in	
-			let file = Str.matched_group 1 data in			
-			let lines = get_deps (Str.matched_group 2 data) 0 in			
-			(Filename.basename file,lines)::(get_lines (newp+1))
 
-		with
 
-			Not_found -> []
 
-	in
 
-	let lines = get_lines 0 in
 
-	let init_infos (ext,fname) =
 
-		let deptarget = Filename.basename (match ext with
 
-			| ML ->  fname +! CMO
 
-			| MLI -> fname +! CMI
 
-			| _ -> fname) in
 
-		let target = (match ext with
 
-			| ML -> fname +! (if opt then CMX else CMO)
 
-			| MLI -> fname +! CMI
 
-			| _ -> fname) in
 
-		{
 
-			name = fname;
 
-			ext = ext;
 
-			target = target;
 
-			deps =
 
-				(try
 
-					snd (List.find (fun (n,_) -> n = deptarget) lines)
 
-				with
 
-					Not_found -> []);
 
-		}
 
-	in	
-	let deps = List.map init_infos files in
 
-	match !verbose with
 
-	| false -> deps
 
-	| true ->
 
-		let print_dep d =
 
-			let dl = String.concat " " (List.map Filename.basename d.deps) in
 
-			printf "%s: %s\n" (Filename.basename d.target) dl;
 
-		in
 
-		List.iter print_dep deps;
 
-		deps
 
-
 
-let rec graph_topological_sort all g priority acc =
 
-	let has_dep where dep =	
-		List.exists (fun f -> Filename.basename f.target =
 
-							Filename.basename dep) where
 
-	in
 
-	let modified a b = (file_time a) < (file_time b) in
 
-	let is_free file = not(List.exists (has_dep g) file.deps) in
 
-	let rec has_priority = function
 
-		| [] -> raise Not_found
 
-		| x :: l ->
 
-			try
 
-				List.find (fun f -> x = (Filename.basename f.name)) g
 
-			with
 
-				Not_found -> has_priority l
 
-	in
 
-	let to_build file =
 
-		all || (* rebuild all *)
 
-		List.exists (has_dep acc) file.deps || (* a dep is rebuild *)
 
-		List.exists (modified file.target) file.deps || (* dep modified *)
 
-		(file_time file.target) < (file_time file.name) (* is modified *)
 
-	in
 
-	match g with
 
-	| [] -> acc
 
-	| _ ->
 
-		let free,g = List.partition is_free g in
 
-		match free with 
-		| [] ->
 
-			(try
 
-				let free = has_priority priority in
 
-				let g = List.filter ((<>) free) g in
 
-				if to_build free then
 
-					graph_topological_sort all g priority (acc@[free])
 
-				else
 
-					graph_topological_sort all g priority acc;
 
-			with Not_found ->
 
-				List.iter (fun f -> prerr_endline f.name) g;
 
-				failwith "Cycle detected in file dependencies !")
 
-		| _ ->
 
-			let to_build = List.filter to_build free in
 
-			graph_topological_sort all g priority (acc@to_build)
 
-
 
-(* ************************************************************************ *)
 
-(* COMPILATION *)
 
-
 
-let compile ?(precomp=false) opt paramlist f =
 
-	try
 
-		let command = (match f.ext with
 
-		| ML | MLI ->
 
-			let params = flatten paramlist in
 
-			let compiler = (if opt then "ocamlopt" else "ocamlc") in
 
-			sprintf "%s -c %s %s" compiler params (escape f.name)
 
-		| MLL when precomp -> "ocamllex " ^ (escape f.name)
 
-		| MLY when precomp -> "ocamlyacc " ^ (escape f.name)
 
-		| _ -> raise Exit) in
 
-		print (Filename.basename (unescape f.name));
 
-		let stdout,stderr = exec command "Build failed" in
 
-		try
 
-			print_errors (stderr@stdout) "";
 
-		with
 
-			Failure _ -> ()
 
-	with
 
-		Exit -> ()
 
-
 
-let pre_compile all (ext,name) =
 
-	match ext with
 
-	| MLL | MLY ->
 
-		let time = file_time name in
 
-		if time = 0. then failwith ("No such file : "^(escape name));
 
-		if all || (file_time (name +! ML)) < time then
 
-			compile ~precomp:true false [] {
 
-				name = name;
 
-				ext = ext;
 
-				deps = [];
 
-				target = "";
 
-			}
 
-	| _ -> () (* other files type does not need pre-compilation *)
 
-
 
-let clean_targets opt acc (ext,name) =	
-	match ext with
 
-	| MLY ->
 
-		(name +! ML) :: (name +! MLI) :: acc
 
-	| MLL ->
 
-		(name +! ML) :: acc
 
-	| ML when opt ->
 
-		(name +! (if Sys.os_type = "Win32" then OBJ else O)) :: (name +! CMX) :: (name +! CMI) :: acc
 
-	| ML ->
 
-		(name +! CMO) :: (name +! CMI) :: acc
 
-	| MLI ->
 
-		(name +! CMI) :: acc
 
-	| _ ->
 
-		acc
 
-
 
-(*
 
-	In order to link, we need to order the CMO files.
 
-	We currently have a ML/MLI dependency graph (in fact, tree) generated
 
-	by ocamldep.
 
-
 
-	To build the CMO list, we are reducing the dep-tree into one graph merging
 
-	corresponding ML & MLI nodes. ML-ML edges are keeped, ML-MLI edges
 
-	become ML-ML edges only if they do not create a cycle in the reduced
 
-	graph.
 
-
 
-	Then we sort the graph using topological ordering.
 
-*)
 
-let graph_reduce opt g =
 
-	let ext = (if opt then CMX else CMO) in
 
-	let rec path_exists g a b =
 
-		if a = b then true else
 
-		try
 
-			let f = List.find (fun f -> f.target = a) g in
 
-			List.exists (fun d -> path_exists g d b) f.deps
 
-		with
 
-			Not_found -> false
 
-	in
 
-	let rec deps_reduce f g = function		
-		| [] -> []
 
-		| dep::deps ->
 
-			match extension dep with
 
-			| "CMI" when not(path_exists g (dep +! ext) f.target) ->				
-				(dep +! ext)::(deps_reduce f g deps)
 
-			| "CMO" | "CMX" ->
 
-				dep::(deps_reduce f g deps)
 
-			| _ -> deps_reduce f g deps
 
-	in
 
-	let rec do_reduce g acc =
 
-		match g with
 
-		| [] -> acc
 
-		| f::g' ->			
-			let f = { f with deps = deps_reduce f (g@acc) f.deps } in
 
-			do_reduce g' (f::acc)
 
-	in
 
-	do_reduce g []	
-
 
-let is_lib f = match f.ext with
 
-	| CMA | CMXA | CMO | CMX | DLL | SO | LIB | A | O | OBJ -> true
 
-	| _ -> false
 
-
 
-let link opt paramlist files priority output =
 
-	print "Linking...";
 
-	let sources = List.filter (fun f -> f.ext = ML) files in
 
-	let libs = List.filter is_lib files in
 
-	let sources = graph_topological_sort true (graph_reduce opt sources) priority [] in
 
-	let lparams = flatten (List.map (fun f -> escape f.name) libs) in
 
-	let sparams = flatten (List.map (fun f -> escape f.target) sources) in
 
-	let params = flatten paramlist in
 
-	let cc = (if opt then "ocamlopt" else "ocamlc") in
 
-	let cmd = sprintf "%s %s %s %s -o %s" cc params lparams sparams output in
 
-	ignore(exec ~stdout:true cmd "Linking failed")
 
-
 
-(* ************************************************************************ *)
 
-(* FILE PROCESSING *)
 
-
 
-let dsp_get_files dsp_file =
 
-	let get_file line =
 
-		if String.length line > 7 && String.sub line 0 7 = "SOURCE=" then
 
-			Some (unescape (String.sub line 7 (String.length line-7)))
 
-		else
 
-			None
 
-	in
 
-	filter_all_in get_file (open_in dsp_file)
 
-
 
-let vcproj_get_files vcp_file =
 
-	let get_file line =
 
-		let len = String.length line in
 
-		let p = ref 0 in
 
-		while !p < len && (line.[!p] = ' ' || line.[!p] = '\t') do
 
-			incr p;
 
-		done;
 
-		let line = String.sub line !p (len - !p) in		
-		if String.length line > 13 && String.sub line 0 13 = "RelativePath=" then begin
 
-			let str = String.sub line 13 (String.length line - 14) in
 
-			Some (unescape str)
 
-		end else
 
-			None
 
-	in
 
-	filter_all_in get_file (open_in vcp_file)
 
-
 
-let rec list_files errors file =
 
-	match extension file with
 
-	| "ML" -> [(ML,file)]
 
-	| "MLI" -> [(MLI,file)]
 
-	| "VCPROJ" ->
 
-		project_name := Some (Filename.basename file);
 
-		error_process := true;
 
-		chars_process := true;
 
-		List.concat (List.map (list_files false) (vcproj_get_files file))
 
-	| "DSP" ->
 
-		project_name := Some (Filename.basename file);
 
-		error_process := true;
 
-		chars_process := true;
 
-		List.concat (List.map (list_files false) (dsp_get_files file))
 
-	| "CMA" -> [(CMA,file)]
 
-	| "CMXA" -> [(CMXA,file)]
 
-	| "CMX" -> [(CMX,file)]	
-	| "CMO" -> [(CMO,file)]
 
-	| "DLL" -> [(DLL,file)]
 
-	| "LIB" -> [(LIB,file)]
 
-	| "A" -> [(A,file)]
 
-	| "O" -> [(O,file)]
 
-	| "OBJ" -> [(OBJ,file)]
 
-	| "SO" -> [(SO,file)]
 
-	| "MLY" -> [(MLY,file);(ML,file +! ML);(MLI,file +! MLI)]
 
-	| "MLL" -> [(MLL,file);(ML,file +! ML)]	
-	| _ -> if errors then ??? file else []
 
-
 
-let rec get_compile_mode cm = function
 
-	| [] -> cm
 
-	| (ext,name)::files ->
 
-		let error() = failwith "Mixed bytecode and native compilation files." in
 
-		match ext with
 
-		| ML | MLI | MLL | MLY | DLL | SO ->
 
-			get_compile_mode cm files
 
-		| CMA | CMO ->
 
-			if cm = CM_OPT then error() else get_compile_mode CM_BYTE files
 
-		| CMXA | CMX | A | O | OBJ | LIB ->
 
-			if cm = CM_BYTE then error() else get_compile_mode CM_OPT files
 
-		| EXE | CMI ->
 
-			assert false
 
-
 
-let rec get_output_file islib cm =
 
-	match !project_name,islib,cm with
 
-	| None, _ , _ -> None
 
-	| Some name,false,_ -> Some (name +! EXE)
 
-	| Some name,true,CM_OPT -> Some (name +! CMXA)
 
-	| Some name,true,_ -> Some (name +! CMA)
 
-
 
-(* ************************************************************************ *)
 
-(* MAIN *)
 
-
 
-;;
 
-try
 
-
 
-let usage =
 
-	"OCAMAKE v1.4 - Copyright (C)2002-2005 Nicolas Cannasse"
 
-	^"\r\nLast version : http://tech.motion-twin.com" in
 
-let compile_mode = ref CM_DEFAULT in
 
-let compile_cma = ref false in
 
-let do_clean = ref false in
 
-let gen_make = ref false in
 
-let rebuild_all = ref false in
 
-let output_file = ref None in
 
-let preprocessor = ref None in
 
-let argfiles = ref [] in
 
-let paths = ref [] in
 
-let cflags = ref [] in
 
-let lflags = ref [] in
 
-let remf = ref [] in
 
-let priority = ref [] in
 
-let arg_spec = [
 
-  ("-all", Unit (fun () -> rebuild_all := true), ": rebuild all files");
 
-  ("-o", String (fun f -> output_file := Some f), "<file> : set output");
 
-  ("-a", Unit (fun () -> compile_cma := true), ": build a library");
 
-  ("-opt", Unit (fun () -> compile_mode := CM_OPT), ": native compilation");
 
-  ("-clean", Unit (fun () -> do_clean := true), ": delete intermediate files");
 
-  ("-I", String (fun p -> paths := p::!paths), "<path> : additional path");
 
-  ("-v", Unit (fun () -> verbose := true), ": turn on verbose mode");
 
-  ("-n", String (fun f -> remf := f::!remf),"<file>: don't compile this file");
 
-  ("-mak", Unit (fun () -> gen_make := true), ": generate Makefile");
 
-  ("-lp", String (fun f -> lflags := f::!lflags), "<p> : linker parameter");
 
-  ("-cp", String (fun f -> cflags := f::!cflags), "<p> : compiler parameter");
 
-  ("-pp", String (fun c -> preprocessor := Some c), "<cmd> : preprocessor");
 
-  ("-epp", Unit (fun() -> error_process := true), ": use MSVC error messages format");
 
-  ("-cpp", Unit (fun() -> chars_process := true), ": convert characters range in errors to file expression");
 
-  ("-g", Unit (fun () -> lflags := "-g"::!lflags; cflags := "-g"::!cflags), ": compile/link in debug mode");
 
-  ("-P", String (fun f -> priority := f::!priority), ": give linking priority to a file when linking ordering failed");
 
-] in
 
-Arg.parse arg_spec (fun arg -> argfiles := arg :: !argfiles) usage;
 
-let files = List.concat (List.map (list_files true) (List.rev !argfiles)) in
 
-let files = List.filter (fun (_,f) ->
 
-	let name = Filename.basename f in
 
-	not(List.exists (fun f -> Filename.basename f = name) !remf)) files in
 
-let compile_mode = get_compile_mode !compile_mode files in
 
-let output_file , compile_mode = (match !output_file with
 
-	| None -> get_output_file !compile_cma compile_mode , compile_mode
 
-	| Some file ->
 
-		match extension file , compile_mode with
 
-		| "CMA" , CM_OPT
 
-		| "CMXA", CM_BYTE -> failwith "Mixed bytecode and native compilation files."
 
-		| "CMA" , _ ->
 
-			compile_cma := true;
 
-			Some file , CM_BYTE
 
-		| "CMXA" , _ ->
 
-			compile_cma := true;
 
-			Some file , CM_OPT
 
-		| _ , _ ->
 
-			Some file , compile_mode)
 
-in
 
-let opt = (compile_mode = CM_OPT) in
 
-if !compile_cma then lflags := "-a"::!lflags;
 
-match files with
 
-  | [] -> Arg.usage arg_spec usage
 
-  | _ ->
 
-	let files = remove_duplicates files in
 
-	let get_path (_,f) = "-I " ^ escape (Filename.dirname f) in
 
-	let paths = List.map (fun p -> "-I " ^ (escape p)) !paths in
 
-	let paths = remove_duplicates (paths@(List.map get_path files)) in
 
-	let p4param = if_some (fun cmd -> "-pp " ^ (escape cmd)) !preprocessor "" in
 
-	match !do_clean,!gen_make with
 
-	| true,true ->
 
-		failwith "Cannot have -mak & -clean at the same time"
 
-	| false,false ->
 
-		if_some delete_file output_file ();
 
-		List.iter (pre_compile !rebuild_all) files;
 
-		List.iter check_existence files;
 
-		let g = build_graph opt (p4param::paths) files in
 
-		let files = graph_topological_sort !rebuild_all g [] [] in
 
-		List.iter (compile opt (!cflags @ p4param::paths)) files;
 
-		if_some (link opt (!lflags @ paths) g (List.rev !priority)) output_file ();
 
-		print "Done";
 
-	| true,false ->
 
-		print "Cleaning...";
 
-		if_some delete_file output_file ();
 
-		let to_clean = List.fold_left (clean_targets opt) [] files in
 
-		List.iter delete_file to_clean;
 
-		if opt && !compile_cma then
 
-			if_some (fun f -> delete_file (f +! (if Sys.os_type = "Win32" then LIB else A))) output_file ();
 
-	| false,true ->
 
-		List.iter (pre_compile !rebuild_all) files;
 
-		let g = build_graph opt (p4param::paths) files in
 
-		let out = open_out "Makefile" in
 
-		let fprint s = output_string out (s^"\n") in
 
-		let genmak f =
 
-			let ext = if opt then CMX else CMO in
 
-			match f.ext with
 
-			| MLL ->
 
-				fprint ((f.name +! ext)^": "^(f.name +! ML)^"\n")
 
-			| MLY ->
 
-				fprint ((f.name +! ext)^": "^(f.name +! ML)^"\n");
 
-				fprint ((f.name +! CMI)^": "^(f.name +! ML)^" "^(f.name +! MLI)^"\n")
 
-			| _ when f.deps <> [] ->
 
-				fprint (f.target^": "^(flatten f.deps)^"\n")
 
-			| _ ->
 
-				()
 
-		in
 
-		let compiles = graph_topological_sort true g [] [] in
 
-		let libs = List.filter is_lib compiles in
 
-		let cmos = List.filter (fun f -> f.ext = ML) compiles in
 
-		fprint "# Makefile generated by OCamake ";
 
-		fprint "# http://tech.motion-twin.com";
 
-		fprint ".SUFFIXES : .ml .mli .cmo .cmi .cmx .mll .mly";
 
-		fprint "";
 
-		fprint ("ALL_CFLAGS= $(CFLAGS) "^(flatten (!cflags @ p4param::paths)));
 
-		fprint ("LIBS="^(flatten (List.map (fun f -> f.name) libs)));
 
-		let targets = flatten (List.map (fun f -> f.target) cmos) in
 
-		(match output_file with
 
-		| None ->
 
-			fprint "";
 
-			fprint ("all: "^targets^"\n");
 
-		| Some out ->
 
-			fprint ("LFLAGS= -o "^out^" "^(flatten (!lflags @ paths)));
 
-			fprint "";
 
-			fprint ("all: "^out^"\n");
 
-			fprint (out^": "^targets);
 
-			(* I need to reuse the list of targets since $^ is for Make and $** for NMake *)
 
-			fprint ("\t"^(if opt then "ocamlopt" else "ocamlc")^" $(LFLAGS) $(LIBS) "^targets^"\n"));
 
-		List.iter genmak g;
 
-		fprint "";
 
-		fprint "clean:";
 
-		let cleanfiles = flatten (List.fold_left (clean_targets opt) [] files) in
 
-		if_some (fun o ->
 
-				fprint ("\trm -f "^o);
 
-				if opt && !compile_cma then fprint ("\trm -f "^(o +! LIB)^" "^(o +! A));
 
-			) output_file ();
 
-		fprint ("\trm -f "^cleanfiles);
 
-		fprint "";
 
-		fprint "wclean:";
 
-		if_some (fun o ->
 
-				fprint ("\t-@del "^o^" 2>NUL");
 
-				if opt && !compile_cma then fprint ("\t-@del "^(o +! LIB)^" "^(o +! A)^" 2>NUL");
 
-		) output_file ();
 
-		fprint ("\t-@del "^cleanfiles^" 2>NUL");
 
-		fprint "";
 
-		fprint "# SUFFIXES";
 
-		fprint ".ml.cmo:\n\tocamlc $(ALL_CFLAGS) -c $<\n";
 
-		fprint ".ml.cmx:\n\tocamlopt $(ALL_CFLAGS) -c $<\n";
 
-		fprint ".mli.cmi:\n\tocamlc $(ALL_CFLAGS) $<\n";
 
-		fprint ".mll.ml:\n\tocamllex $<\n";
 
-		fprint ".mly.ml:\n\tocamlyacc $<\n";
 
-		close_out out
 
-with
 
-	Failure msg ->
 
-		Pervasives.flush Pervasives.stdout;
 
-		prerr_endline msg;
 
-		Pervasives.flush Pervasives.stderr;
 
-		exit 1;
 
-
 
-(* ************************************************************************ *)

+ 0 - 21
libs/swflib/swflib.sln
Ver Ficheiro 

@@ -1,21 +0,0 @@
 
-Microsoft Visual Studio Solution File, Format Version 8.00
 
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "swflib", "swflib.vcproj", "{A9DD9D90-85E1-4FCF-8C09-42BF78942849}"
 
-	ProjectSection(ProjectDependencies) = postProject
 
-	EndProjectSection
 
-EndProject
 
-Global
 
-	GlobalSection(SolutionConfiguration) = preSolution
 
-		Bytecode = Bytecode
 
-		Native code = Native code
 
-	EndGlobalSection
 
-	GlobalSection(ProjectConfiguration) = postSolution
 
-		{A9DD9D90-85E1-4FCF-8C09-42BF78942849}.Bytecode.ActiveCfg = Bytecode|Win32
 
-		{A9DD9D90-85E1-4FCF-8C09-42BF78942849}.Bytecode.Build.0 = Bytecode|Win32
 
-		{A9DD9D90-85E1-4FCF-8C09-42BF78942849}.Native code.ActiveCfg = Native code|Win32
 
-		{A9DD9D90-85E1-4FCF-8C09-42BF78942849}.Native code.Build.0 = Native code|Win32
 
-	EndGlobalSection
 
-	GlobalSection(ExtensibilityGlobals) = postSolution
 
-	EndGlobalSection
 
-	GlobalSection(ExtensibilityAddIns) = postSolution
 
-	EndGlobalSection
 
-EndGlobal

+ 0 - 80
libs/swflib/swflib.vcproj
Ver Ficheiro 

@@ -1,80 +0,0 @@
 
-<?xml version="1.0" encoding="Windows-1252"?>
 
-<VisualStudioProject
 
-	ProjectType="Visual C++"
 
-	Version="7.10"
 
-	Name="swflib"
 
-	SccProjectName=""
 
-	SccLocalPath=""
 
-	Keyword="MakeFileProj">
 
-	<Platforms>
 
-		<Platform
 
-			Name="Win32"/>
 
-	</Platforms>
 
-	<Configurations>
 
-		<Configuration
 
-			Name="Native code|Win32"
 
-			OutputDirectory="."
 
-			IntermediateDirectory="."
 
-			ConfigurationType="0"
 
-			UseOfMFC="0"
 
-			ATLMinimizesCRunTimeLibraryUsage="FALSE">
 
-			<Tool
 
-				Name="VCNMakeTool"
 
-				BuildCommandLine="ocamake -opt swfLib.vcproj -a -g"
 
-				ReBuildCommandLine="ocamake -opt swfLib.vcproj -a -g -all"
 
-				Output="swflib.exe"/>
 
-		</Configuration>
 
-		<Configuration
 
-			Name="Bytecode|Win32"
 
-			OutputDirectory="."
 
-			IntermediateDirectory="."
 
-			ConfigurationType="0"
 
-			UseOfMFC="0"
 
-			ATLMinimizesCRunTimeLibraryUsage="FALSE">
 
-			<Tool
 
-				Name="VCNMakeTool"
 
-				BuildCommandLine="ocamake -a swfLib.vcproj"
 
-				ReBuildCommandLine="ocamake -a swfLib.vcproj -all"
 
-				Output="swflib.exe"/>
 
-		</Configuration>
 
-	</Configurations>
 
-	<References>
 
-	</References>
 
-	<Files>
 
-		<File
 
-			RelativePath=".\actionScript.ml">
 
-		</File>
 
-		<File
 
-			RelativePath=".\as3.mli">
 
-		</File>
 
-		<File
 
-			RelativePath=".\as3code.ml">
 
-		</File>
 
-		<File
 
-			RelativePath=".\as3hl.mli">
 
-		</File>
 
-		<File
 
-			RelativePath=".\as3hlparse.ml">
 
-		</File>
 
-		<File
 
-			RelativePath=".\as3parse.ml">
 
-		</File>
 
-		<File
 
-			RelativePath=".\png.ml">
 
-		</File>
 
-		<File
 
-			RelativePath=".\png.mli">
 
-		</File>
 
-		<File
 
-			RelativePath=".\swf.ml">
 
-		</File>
 
-		<File
 
-			RelativePath=".\swfParser.ml">
 
-		</File>
 
-		<File
 
-			RelativePath=".\swfPic.ml">
 
-		</File>
 
-	</Files>
 
-	<Globals>
 
-	</Globals>
 
-</VisualStudioProject>

+ 0 - 31
libs/ttflib/Makefile
Ver Ficheiro 

@@ -1,31 +0,0 @@
 
-OCAMLOPT=ocamlopt
 
-OCAMLC=ocamlc
 
-
 
-FLAGS=-package extlib -safe-string -I ../extlib-leftovers -I ../swflib
 
-FILES=tTFData tTFParser tTFTools tTFSwfWriter tTFCanvasWriter tTFJsonWriter
 
-LIBS=extLib swflib unix
 
-
 
-OUTPUT=ttf
 
-
 
-all: native bytecode
 
-
 
-native: ttflib.cmxa
 
-
 
-bytecode: ttflib.cma
 
-
 
-ttflib.cmxa: $(FILES:=.ml)
 
-	ocamlfind $(OCAMLOPT) $(FLAGS) $(FILES:=.ml) -g -a -o ttflib.cmxa
 
-
 
-ttflib.cma: $(FILES:=.ml)
 
-	ocamlfind $(OCAMLC) $(FLAGS) $(FILES:=.ml) -g -a -o ttflib.cma
 
-
 
-exec:
 
-	ocamlfind $(OCAMLOPT) $(FLAGS) $(LIBS:=.cmxa) $(FILES:=.ml) main.ml -g -o $(OUTPUT)
 
-
 
-clean:
 
-	rm -rf ttflib.cmxa ttflib.cma ttflib.lib ttflib.a $(wildcard *.cmx) $(wildcard *.obj) $(wildcard *.o) $(wildcard *.cmi) $(wildcard *.cmo)
 
-
 
-.PHONY: all native bytecode clean exec
 
-
 
-Makefile: ;
 
-$(FILES:=.ml): ;

+ 0 - 14
libs/ttflib/dune
Ver Ficheiro 

@@ -1,14 +0,0 @@
 
-(include_subdirs no)
 
-
 
-(env
 
-	(_
 
-		(flags (-w -3 -w -27 -w -35))
 
-	)
 
-)
 
-
 
-(library
 
-	(name ttflib)
 
-	(libraries extlib extlib_leftovers swflib unix)
 
-	(modules (:standard \ main))
 
-	(wrapped false)
 
-)

+ 0 - 139
libs/ttflib/main.ml
Ver Ficheiro 

@@ -1,139 +0,0 @@
 
-open TTFData
 
-
 
-exception Abort
 
-
 
-let gen_hxswfml_debug fontname =
 
-	let xml = "<?xml version=\"1.0\" ?>
 
-	<swf>
 
-		<FileAttributes/>
 
-		<Custom tagId=\"75\" file=\"" ^ fontname ^ ".dat\" comment=\"DefineFont3\"/>
 
-		<SymbolClass id=\"1\" class=\"TestFont\" base=\"flash.text.Font\"/>
 
-		<DefineABC file=\"Main.swf\" isBoot=\"true\"/>
 
-		<ShowFrame/>
 
-	</swf>"
 
-	in
 
-	Std.output_file (fontname ^ ".fxml") xml;
 
-	if Sys.command "haxe -main Main -swf main.swf" <> 0 then failwith "Error while executing haxe";
 
-	if Sys.command ("hxswfml xml2swf \"" ^ fontname ^ ".fxml\" \"" ^ fontname ^ ".swf\" -no-strict") <> 0 then failwith "Error while executing hxswfml";
 
-	Unix.unlink (fontname ^ ".fxml");
 
-	Unix.unlink "main.swf"
 
-
 
-let normalize_path p =
 
-	let l = String.length p in
 
-	if l = 0 then
 
-		"./"
 
-	else begin
 
-		let p = String.concat "/" (ExtString.String.nsplit p "\\") in
 
-		match p.[l-1] with
 
-		| '/' -> p
 
-		| _ -> p ^ "/"
 
-	end
 
-
 
-let mk_dir_rec dir =
 
-	let dir = normalize_path dir in
 
-	let parts = ExtString.String.nsplit dir "/" in
 
-	let rec create acc = function
 
-		| [] -> ()
 
-		| "" :: [] -> ()
 
-		| d :: l ->
 
-			let dir = String.concat "/" (List.rev (d :: acc)) in
 
-			if not (Sys.file_exists dir) then Unix.mkdir dir 0o755;
 
-			create (d :: acc) l
 
-	in
 
-	create [] parts
 
-
 
-let exit msg =
 
-	prerr_endline msg;
 
-	raise Abort
 
-
 
-let process args =
 
-	let fonts = ref [] in
 
-	let range_str = ref "" in
 
-	let targets = ref [] in
 
-	let debug_hxswfml = ref false in
 
-	let args_callback s = fonts := s :: !fonts in
 
-	let usage = Printf.sprintf
 
-		"Ttf <font paths> (-swf|-canvas)"
 
-	in
 
-	let basic_args = [
 
-		("-range",Arg.String (fun str ->
 
-			range_str := str;
 
-		),"<str> : specifies the character range");
 
-		("-swf",Arg.String (fun dir ->
 
-			mk_dir_rec dir;
 
- 			let f ttf range_str =
 
- 				let config = {
 
- 					ttfc_range_str = range_str;
 
- 					ttfc_font_name = None;
 
-					ttfc_font_weight = TFWRegular;
 
-					ttfc_font_posture = TFPNormal;
 
- 				} in
 
-				let f2 = TTFSwfWriter.to_swf ttf config in
 
-				let ch = IO.output_channel (open_out_bin (dir ^ "/" ^ ttf.ttf_font_name ^ ".dat")) in
 
-				let b = IO.output_bits ch in
 
-				IO.write_i16 ch 1;
 
-				TTFSwfWriter.write_font2 ch b f2;
 
-				IO.close_out ch;
 
-				if !debug_hxswfml then begin
 
-					if not (Sys.file_exists "Main.hx") then failwith "Could not find Main.hx required for -hxswfml-debug";
 
-					let main = Std.input_file "Main.hx" in
 
-					let old = Sys.getcwd () in
 
-					Sys.chdir dir;
 
-					Std.output_file ~filename:"Main.hx" ~text:main;
 
-					gen_hxswfml_debug ttf.ttf_font_name;
 
-					Unix.unlink "Main.hx";
 
-					Sys.chdir old;
 
-				end
 
-			in
 
-			targets := f :: !targets;
 
-		),"<dir> : generate swf tag data to <dir>");
 
-		("-canvas", Arg.String (fun dir ->
 
-			mk_dir_rec dir;
 
- 			let f ttf range_str =
 
- 				let glyphs = TTFCanvasWriter.to_canvas ttf range_str in
 
-				let ch = IO.output_channel (open_out_bin (dir ^ "/" ^ ttf.ttf_font_name ^ ".js")) in
 
-				TTFCanvasWriter.write_font ch ttf glyphs;
 
-				IO.close_out ch;
 
-			in
 
-			targets := f :: !targets;
 
-		),"<dir> : generate canvas draw commands to <dir>");
 
-		("-json", Arg.String (fun dir ->
 
-			mk_dir_rec dir;
 
- 			let f ttf range_str =
 
- 				let glyphs = TTFJsonWriter.to_json ttf range_str in
 
-				let ch = IO.output_channel (open_out_bin (dir ^ "/" ^ ttf.ttf_font_name ^ ".js")) in
 
-				TTFJsonWriter.write_font ch ttf glyphs;
 
-				IO.close_out ch;
 
-			in
 
-			targets := f :: !targets;
 
-		),"<dir> : generate json-encoded glyph information to <dir>");
 
-		("-hxswfml-debug", Arg.Unit (fun () ->
 
-			debug_hxswfml := true;
 
-		),": generate debug swf with hxswfml")
 
-	] in
 
-	if Array.length Sys.argv = 1 then
 
-		Arg.usage basic_args usage
 
-	else begin
 
-		Arg.parse basic_args args_callback usage;
 
-		match !fonts,!targets with
 
-		| [],_ ->
 
-			prerr_endline "Missing font argument";
 
-			Arg.usage basic_args usage
 
-		| _,[] ->
 
-			prerr_endline "No targets specified (-swf|-canvas|-json)";
 
-			Arg.usage basic_args usage
 
-		| fonts,targets ->
 
-			List.iter (fun font ->
 
-				let ch = try open_in_bin font with _ -> exit ("No such file: " ^ font) in
 
-				let ttf = TTFParser.parse ch in
 
-				List.iter (fun target ->
 
-					target ttf !range_str
 
-				) targets;
 
-				close_in ch;
 
-			) fonts;
 
-	end
 
-;;
 
-try
 
-	process Sys.argv;
 
-with Abort ->
 
-	()

+ 0 - 50
libs/ttflib/tTFCanvasWriter.ml
Ver Ficheiro 

@@ -1,50 +0,0 @@
 
-(*
 
- * Copyright (C)2005-2014 Haxe Foundation
 
- *
 
- * Permission is hereby granted, free of charge, to any person obtaining a
 
- * copy of this software and associated documentation files (the "Software"),
 
- * to deal in the Software without restriction, including without limitation
 
- * the rights to use, copy, modify, merge, publish, distribute, sublicense,
 
- * and/or sell copies of the Software, and to permit persons to whom the
 
- * Software is furnished to do so, subject to the following conditions:
 
- *
 
- * The above copyright notice and this permission notice shall be included in
 
- * all copies or substantial portions of the Software.
 
- *
 
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 
- * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 
- * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
 
- * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
 
- * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 
- * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
 
- * DEALINGS IN THE SOFTWARE.
 
- *)
 
-
 
-open TTFData
 
-open TTFTools
 
-
 
-let rec write_glyph ttf key glyf =
 
-	key,TTFTools.build_glyph_paths ttf false glyf
 
-
 
-let write_font ch ttf glyphs =
 
-	let scale = 1024. /. (float_of_int ttf.ttf_head.hd_units_per_em) in
 
-	List.iter (fun (key,paths) ->
 
-		IO.nwrite_string ch (Printf.sprintf "\tfunction key%i(ctx) {\n" key);
 
-		IO.nwrite_string ch "\t\tctx.beginPath();\n";
 
-		List.iter (fun path ->
 
-			IO.nwrite_string ch (match path.gp_type with
 
-			| 0 -> Printf.sprintf "\t\tctx.moveTo(%.2f,%.2f);\n" (path.gp_x *. scale) (path.gp_y *. scale *. (-1.))
 
-			| 1 -> Printf.sprintf "\t\tctx.lineTo(%.2f,%.2f);\n" (path.gp_x *. scale) (path.gp_y *. scale *. (-1.))
 
-			| 2 -> Printf.sprintf "\t\tctx.quadraticCurveTo(%.2f,%.2f,%.2f,%.2f);\n" (path.gp_cx *. scale) (path.gp_cy *. scale *. (-1.)) (path.gp_x *. scale) (path.gp_y *. scale *. (-1.))
 
-			| _ -> assert false)
 
-		) paths;
 
-		IO.nwrite_string ch "\t\tctx.fill();\n";
 
-		IO.nwrite_string ch "\t}\n";
 
-	) glyphs;
 
-	()
 
-
 
-let to_canvas ttf range_str =
 
-	let lut = TTFTools.build_lut ttf range_str in
 
-	let glyfs = Hashtbl.fold (fun k v acc -> (k,ttf.ttf_glyfs.(v)) :: acc) lut [] in
 
-	let glyfs = List.stable_sort (fun a b -> compare (fst a) (fst b)) glyfs in
 
-	List.map (fun (k,g) -> write_glyph ttf k g) glyfs

+ 0 - 360
libs/ttflib/tTFData.ml
Ver Ficheiro 

@@ -1,360 +0,0 @@
 
-(*
 
- * Copyright (C)2005-2014 Haxe Foundation
 
- *
 
- * Permission is hereby granted, free of charge, to any person obtaining a
 
- * copy of this software and associated documentation files (the "Software"),
 
- * to deal in the Software without restriction, including without limitation
 
- * the rights to use, copy, modify, merge, publish, distribute, sublicense,
 
- * and/or sell copies of the Software, and to permit persons to whom the
 
- * Software is furnished to do so, subject to the following conditions:
 
- *
 
- * The above copyright notice and this permission notice shall be included in
 
- * all copies or substantial portions of the Software.
 
- *
 
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 
- * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 
- * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
 
- * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
 
- * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 
- * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
 
- * DEALINGS IN THE SOFTWARE.
 
- *)
 
-
 
-type header = {
 
-	hd_major_version : int;
 
-	hd_minor_version : int;
 
-	hd_num_tables : int;
 
-	hd_search_range : int;
 
-	hd_entry_selector : int;
 
-	hd_range_shift : int;
 
-}
 
-
 
-type entry = {
 
-	entry_table_name : string;
 
-	entry_checksum : int32;
 
-	entry_offset : int32;
 
-	entry_length: int32;
 
-}
 
-
 
-(* GLYF *)
 
-
 
-type glyf_header = {
 
-	gh_num_contours : int;
 
-	gh_xmin : int;
 
-	gh_ymin : int;
 
-	gh_xmax : int;
 
-	gh_ymax : int;
 
-}
 
-
 
-type glyf_simple = {
 
-	gs_end_pts_of_contours : int array;
 
-	gs_instruction_length : int;
 
-	gs_instructions : char array;
 
-	gs_flags : int array;
 
-	gs_x_coordinates : int array;
 
-	gs_y_coordinates : int array;
 
-}
 
-
 
-type transformation_option =
 
-	| NoScale
 
-	| Scale of float
 
-	| ScaleXY of float * float
 
-	| ScaleMatrix of float * float * float * float
 
-
 
-type glyf_component = {
 
-	gc_flags : int;
 
-	gc_glyf_index : int;
 
-	gc_arg1 : int;
 
-	gc_arg2 : int;
 
-	gc_transformation : transformation_option;
 
-}
 
-
 
-type glyf =
 
-	| TGlyfSimple of glyf_header * glyf_simple
 
-	| TGlyfComposite of glyf_header * glyf_component list
 
-	| TGlyfNull
 
-
 
-(* HMTX *)
 
-
 
-type hmtx = {
 
-	advance_width : int;
 
-	left_side_bearing : int;
 
-}
 
-
 
-(* CMAP *)
 
-
 
-type cmap_subtable_header = {
 
-	csh_platform_id : int;
 
-	csh_platform_specific_id : int;
 
-	csh_offset : int32;
 
-}
 
-
 
-type cmap_format_0 = {
 
-	c0_format : int;
 
-	c0_length : int;
 
-	c0_language : int;
 
-	c0_glyph_index_array : char array;
 
-}
 
-
 
-type cmap_format_4 = {
 
-	c4_format : int;
 
-	c4_length : int;
 
-	c4_language : int;
 
-	c4_seg_count_x2 : int;
 
-	c4_search_range : int;
 
-	c4_entry_selector : int;
 
-	c4_range_shift : int;
 
-	c4_end_code : int array;
 
-	c4_reserved_pad : int;
 
-	c4_start_code : int array;
 
-	c4_id_delta : int array;
 
-	c4_id_range_offset : int array;
 
-	c4_glyph_index_array : int array;
 
-}
 
-
 
-type cmap_format_6 = {
 
-	c6_format : int;
 
-	c6_length : int;
 
-	c6_language : int;
 
-	c6_first_code : int;
 
-	c6_entry_count : int;
 
-	c6_glyph_index_array : int array;
 
-}
 
-
 
-type cmap_format_12_group = {
 
-	c12g_start_char_code : int32;
 
-	c12g_end_char_code : int32;
 
-	c12g_start_glyph_code : int32;
 
-}
 
-
 
-type cmap_format_12 = {
 
-	c12_format : int32;
 
-	c12_length : int32;
 
-	c12_language : int32;
 
-	c12_num_groups : int32;
 
-	c12_groups : cmap_format_12_group list;
 
-}
 
-
 
-type cmap_subtable_def =
 
-	| Cmap0 of cmap_format_0
 
-	| Cmap4 of cmap_format_4
 
-	| Cmap6 of cmap_format_6
 
-	| Cmap12 of cmap_format_12
 
-	| CmapUnk of string
 
-
 
-type cmap_subtable = {
 
-	cs_header : cmap_subtable_header;
 
-	cs_def : cmap_subtable_def;
 
-}
 
-
 
-type cmap = {
 
-	cmap_version : int;
 
-	cmap_num_subtables : int;
 
-	cmap_subtables : cmap_subtable list;
 
-}
 
-
 
-(* KERN *)
 
-
 
-type kern_subtable_header = {
 
-	ksh_length : int32;
 
-	ksh_coverage : int;
 
-	ksh_tuple_index : int;
 
-}
 
-
 
-type kern_pair = {
 
-	kern_left : int;
 
-	kern_right : int;
 
-	kern_value : int;
 
-}
 
-
 
-type kern_format_0 = {
 
-	k0_num_pairs : int;
 
-	k0_search_range : int;
 
-	k0_entry_selector : int;
 
-	k0_range_shift : int;
 
-	k0_pairs : kern_pair list;
 
-}
 
-
 
-type kern_format_2 = {
 
-	k2_row_width : int;
 
-	k2_left_offset_table : int;
 
-	k2_right_offset_table : int;
 
-	k2_array : int;
 
-	k2_first_glyph : int;
 
-	k2_num_glyphs : int;
 
-	k2_offsets : int list;
 
-}
 
-
 
-type kern_subtable_def =
 
-	| Kern0 of kern_format_0
 
-	| Kern2 of kern_format_2
 
-
 
-type kern_subtable = {
 
-	ks_header : kern_subtable_header;
 
-	ks_def : kern_subtable_def;
 
-}
 
-
 
-type kern = {
 
-	kern_version : int32;
 
-	kern_num_tables : int32;
 
-	kern_subtables : kern_subtable list;
 
-}
 
-
 
-(* NAME *)
 
-
 
-type name_record = {
 
-	nr_platform_id : int;
 
-	nr_platform_specific_id : int;
 
-	nr_language_id : int;
 
-	nr_name_id : int;
 
-	nr_length : int;
 
-	nr_offset : int;
 
-	mutable nr_value : string;
 
-}
 
-
 
-type name = {
 
-	name_format : int;
 
-	name_num_records : int;
 
-	name_offset : int;
 
-	name_records : name_record array;
 
-}
 
-
 
-(* HEAD *)
 
-
 
-type head = {
 
-	hd_version : int32;
 
-	hd_font_revision : int32;
 
-	hd_checksum_adjustment : int32;
 
-	hd_magic_number : int32;
 
-	hd_flags : int;
 
-	hd_units_per_em : int;
 
-	hd_created : float;
 
-	hd_modified : float;
 
-	hd_xmin : int;
 
-	hd_ymin : int;
 
-	hd_xmax : int;
 
-	hd_ymax : int;
 
-	hd_mac_style : int;
 
-	hd_lowest_rec_ppem : int;
 
-	hd_font_direction_hint : int;
 
-	hd_index_to_loc_format : int;
 
-	hd_glyph_data_format : int;
 
-}
 
-
 
-(* HHEA *)
 
-
 
-type hhea = {
 
-	hhea_version : int32;
 
-	hhea_ascent : int;
 
-	hhea_descent : int;
 
-	hhea_line_gap : int;
 
-	hhea_advance_width_max : int;
 
-	hhea_min_left_side_bearing : int;
 
-	hhea_min_right_side_bearing : int;
 
-	hhea_x_max_extent : int;
 
-	hhea_caret_slope_rise : int;
 
-	hhea_caret_slope_run : int;
 
-	hhea_caret_offset : int;
 
-	hhea_reserved : string;
 
-	hhea_metric_data_format : int;
 
-	hhea_number_of_hmetrics :int;
 
-}
 
-
 
-(* LOCA *)
 
-
 
-type loca = int32 array
 
-
 
-(* MAXP *)
 
-
 
-type maxp = {
 
-	maxp_version_number : int32;
 
-	maxp_num_glyphs : int;
 
-	maxp_max_points : int;
 
-	maxp_max_contours : int;
 
-	maxp_max_component_points : int;
 
-	maxp_max_component_contours : int;
 
-	maxp_max_zones : int;
 
-	maxp_max_twilight_points : int;
 
-	maxp_max_storage : int;
 
-	maxp_max_function_defs : int;
 
-	maxp_max_instruction_defs :int;
 
-	maxp_max_stack_elements : int;
 
-	maxp_max_size_of_instructions :int;
 
-	maxp_max_component_elements :int;
 
-	maxp_max_component_depth :int;
 
-}
 
-
 
-(* OS2 *)
 
-
 
-type os2 = {
 
-	os2_version : int;
 
-	os2_x_avg_char_width : int;
 
-	os2_us_weight_class : int;
 
-	os2_us_width_class : int;
 
-	os2_fs_type : int;
 
-	os2_y_subscript_x_size : int;
 
-	os2_y_subscript_y_size : int;
 
-	os2_y_subscript_x_offset : int;
 
-	os2_y_subscript_y_offset : int;
 
-	os2_y_superscript_x_size : int;
 
-	os2_y_superscript_y_size : int;
 
-	os2_y_superscript_x_offset : int;
 
-	os2_y_superscript_y_offset : int;
 
-	os2_y_strikeout_size : int;
 
-	os2_y_strikeout_position : int;
 
-	os2_s_family_class : int;
 
-	os2_b_family_type : int;
 
-	os2_b_serif_style : int;
 
-	os2_b_weight : int;
 
-	os2_b_proportion : int;
 
-	os2_b_contrast : int;
 
-	os2_b_stroke_variation : int;
 
-	os2_b_arm_style : int;
 
-	os2_b_letterform : int;
 
-	os2_b_midline : int;
 
-	os2_b_x_height : int;
 
-	os2_ul_unicode_range_1 : int32;
 
-	os2_ul_unicode_range_2 : int32;
 
-	os2_ul_unicode_range_3 : int32;
 
-	os2_ul_unicode_range_4 : int32;
 
-	os2_ach_vendor_id : int32;
 
-	os2_fs_selection : int;
 
-	os2_us_first_char_index : int;
 
-	os2_us_last_char_index : int;
 
-	os2_s_typo_ascender : int;
 
-	os2_s_typo_descender : int;
 
-	os2_s_typo_line_gap : int;
 
-	os2_us_win_ascent : int;
 
-	os2_us_win_descent : int;
 
-}
 
-
 
-type ttf = {
 
-	ttf_header : header;
 
-	ttf_font_name : string;
 
-	ttf_directory: (string,entry) Hashtbl.t;
 
-	ttf_glyfs : glyf array;
 
-	ttf_hmtx : hmtx array;
 
-	ttf_cmap : cmap;
 
-	ttf_head : head;
 
-	ttf_loca : loca;
 
-	ttf_hhea : hhea;
 
-	ttf_maxp : maxp;
 
-	ttf_name : name;
 
-	ttf_os2 : os2;
 
-	ttf_kern : kern option;
 
-}
 
-
 
-type ttf_font_weight =
 
-	| TFWRegular
 
-	| TFWBold
 
-
 
-type ttf_font_posture =
 
-	| TFPNormal
 
-	| TFPItalic
 
-
 
-type ttf_config = {
 
-	mutable ttfc_range_str : string;
 
-	mutable ttfc_font_name : string option;
 
-	mutable ttfc_font_weight : ttf_font_weight;
 
-	mutable ttfc_font_posture : ttf_font_posture;
 
-}

+ 0 - 49
libs/ttflib/tTFJsonWriter.ml
Ver Ficheiro 

@@ -1,49 +0,0 @@
 
-(*
 
- * Copyright (C)2005-2014 Haxe Foundation
 
- *
 
- * Permission is hereby granted, free of charge, to any person obtaining a
 
- * copy of this software and associated documentation files (the "Software"),
 
- * to deal in the Software without restriction, including without limitation
 
- * the rights to use, copy, modify, merge, publish, distribute, sublicense,
 
- * and/or sell copies of the Software, and to permit persons to whom the
 
- * Software is furnished to do so, subject to the following conditions:
 
- *
 
- * The above copyright notice and this permission notice shall be included in
 
- * all copies or substantial portions of the Software.
 
- *
 
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 
- * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 
- * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
 
- * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
 
- * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 
- * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
 
- * DEALINGS IN THE SOFTWARE.
 
- *)
 
-
 
-open TTFData
 
-open TTFTools
 
-
 
-let rec write_glyph ttf key glyf =
 
-	key,TTFTools.build_glyph_paths ttf false glyf
 
-
 
-let write_font ch ttf glyphs =
 
-	let scale = 1024. /. (float_of_int ttf.ttf_head.hd_units_per_em) in
 
-	IO.nwrite_string ch "{\n\t";
 
-	IO.nwrite_string ch (String.concat ",\n\t" (List.map (fun (key,paths) ->
 
-		(Printf.sprintf "\"g%i\":[" key)
 
-		^ (String.concat "," (List.map (fun path ->
 
-			match path.gp_type with
 
-			| 0 -> Printf.sprintf "[0,%.2f,%.2f]" (path.gp_x *. scale) (path.gp_y *. scale *. (-1.))
 
-			| 1 -> Printf.sprintf "[1,%.2f,%.2f]" (path.gp_x *. scale) (path.gp_y *. scale *. (-1.))
 
-			| 2 -> Printf.sprintf "[2,%.2f,%.2f,%.2f,%.2f]" (path.gp_cx *. scale) (path.gp_cy *. scale *. (-1.)) (path.gp_x *. scale) (path.gp_y *. scale *. (-1.))
 
-			| _ -> assert false
 
-		) paths))
 
-		^ "]";
 
-	) glyphs));
 
-	IO.nwrite_string ch "\n}"
 
-
 
-let to_json ttf range_str =
 
-	let lut = TTFTools.build_lut ttf range_str in
 
-	let glyfs = Hashtbl.fold (fun k v acc -> (k,ttf.ttf_glyfs.(v)) :: acc) lut [] in
 
-	let glyfs = List.stable_sort (fun a b -> compare (fst a) (fst b)) glyfs in
 
-	List.map (fun (k,g) -> write_glyph ttf k g) glyfs

+ 0 - 688
libs/ttflib/tTFParser.ml
Ver Ficheiro 

@@ -1,688 +0,0 @@
 
-(*
 
- * Copyright (C)2005-2014 Haxe Foundation
 
- *
 
- * Permission is hereby granted, free of charge, to any person obtaining a
 
- * copy of this software and associated documentation files (the "Software"),
 
- * to deal in the Software without restriction, including without limitation
 
- * the rights to use, copy, modify, merge, publish, distribute, sublicense,
 
- * and/or sell copies of the Software, and to permit persons to whom the
 
- * Software is furnished to do so, subject to the following conditions:
 
- *
 
- * The above copyright notice and this permission notice shall be included in
 
- * all copies or substantial portions of the Software.
 
- *
 
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 
- * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 
- * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
 
- * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
 
- * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 
- * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
 
- * DEALINGS IN THE SOFTWARE.
 
- *)
 
-
 
-open TTFData
 
-open IO
 
-
 
-type ctx = {
 
-	file : Stdlib.in_channel;
 
-	ch : input;
 
-	mutable entry : entry;
 
-}
 
-
 
-let rd16 = BigEndian.read_i16
 
-let rdu16 = BigEndian.read_ui16
 
-let rd32 = BigEndian.read_i32
 
-let rd32r = BigEndian.read_real_i32
 
-
 
-let parse_header ctx =
 
-	let ch = ctx.ch in
 
-	let major_version = rdu16 ch in
 
-	let minor_version = rdu16 ch in
 
-	let num_tables = rdu16 ch in
 
-	let search_range = rdu16 ch in
 
-	let entry_selector = rdu16 ch in
 
-	let range_shift = rdu16 ch in
 
-	{
 
-		hd_major_version = major_version;
 
-		hd_minor_version = minor_version;
 
-		hd_num_tables = num_tables;
 
-		hd_search_range = search_range;
 
-		hd_entry_selector = entry_selector;
 
-		hd_range_shift = range_shift;
 
-	}
 
-
 
-let parse_directory ctx header =
 
-	let ch = ctx.ch in
 
-	let directory = Hashtbl.create 0 in
 
-	for i = 0 to header.hd_num_tables - 1 do
 
-		let name = nread_string ch 4 in
 
-		let cs = rd32r ch in
 
-		let off = rd32r ch in
 
-		let length = rd32r ch in
 
-		Hashtbl.add directory name {
 
-			entry_table_name = name;
 
-			entry_checksum = cs;
 
-			entry_offset = off;
 
-			entry_length = length;
 
-		}
 
-	done;
 
-	directory
 
-
 
-let parse_head_table ctx =
 
-	let ch = ctx.ch in
 
-	let version = rd32r ch in
 
-	let font_revision = rd32r ch in
 
-	let checksum_adjustment = rd32r ch in
 
-	let magic_number = rd32r ch in
 
-	let flags = rdu16 ch in
 
-	let units_per_em = rdu16 ch in
 
-	let created = BigEndian.read_double ch in
 
-	let modified = BigEndian.read_double ch in
 
-	let xmin = rd16 ch in
 
-	let ymin = rd16 ch in
 
-	let xmax = rd16 ch in
 
-	let ymax = rd16 ch in
 
-	let mac_style = rdu16 ch in
 
-	let lowest_rec_ppem = rdu16 ch in
 
-	let font_direction_hint = rd16 ch in
 
-	let index_to_loc_format = rd16 ch in
 
-	let glyph_data_format = rd16 ch in
 
-	{
 
-		hd_version = version;
 
-		hd_font_revision = font_revision;
 
-		hd_checksum_adjustment = checksum_adjustment;
 
-		hd_magic_number = magic_number;
 
-		hd_flags = flags;
 
-		hd_units_per_em = units_per_em;
 
-		hd_created = created;
 
-		hd_modified = modified;
 
-		hd_xmin = xmin;
 
-		hd_ymin = ymin;
 
-		hd_xmax = xmax;
 
-		hd_ymax = ymax;
 
-		hd_mac_style = mac_style;
 
-		hd_lowest_rec_ppem = lowest_rec_ppem;
 
-		hd_font_direction_hint = font_direction_hint;
 
-		hd_index_to_loc_format = index_to_loc_format;
 
-		hd_glyph_data_format = glyph_data_format;
 
-	}
 
-
 
-let parse_hhea_table ctx =
 
-	let ch = ctx.ch in
 
-	let version = rd32r ch in
 
-	let ascender = rd16 ch in
 
-	let descender = rd16 ch in
 
-	let line_gap = rd16 ch in
 
-	let advance_width_max = rdu16 ch in
 
-	let min_left_side_bearing = rd16 ch in
 
-	let min_right_side_bearing = rd16 ch in
 
-	let x_max_extent = rd16 ch in
 
-	let caret_slope_rise = rd16 ch in
 
-	let caret_slope_run = rd16 ch in
 
-	let caret_offset = rd16 ch in
 
-	let reserved = nread_string ch 8 in
 
-	let metric_data_format = rd16 ch in
 
-	let number_of_hmetrics = rdu16 ch in
 
-	{
 
-		hhea_version = version;
 
-		hhea_ascent = ascender;
 
-		hhea_descent = descender;
 
-		hhea_line_gap = line_gap;
 
-		hhea_advance_width_max = advance_width_max;
 
-		hhea_min_left_side_bearing = min_left_side_bearing;
 
-		hhea_min_right_side_bearing = min_right_side_bearing;
 
-		hhea_x_max_extent = x_max_extent;
 
-		hhea_caret_slope_rise = caret_slope_rise;
 
-		hhea_caret_slope_run = caret_slope_run;
 
-		hhea_caret_offset = caret_offset;
 
-		hhea_reserved = reserved;
 
-		hhea_metric_data_format = metric_data_format;
 
-		hhea_number_of_hmetrics = number_of_hmetrics;
 
-	}
 
-
 
-let parse_maxp_table ctx =
 
-	let ch = ctx.ch in
 
-	let version_number = rd32r ch in
 
-	let num_glyphs = rdu16 ch in
 
-	let max_points = rdu16 ch in
 
-	let max_contours = rdu16 ch in
 
-	let max_component_points = rdu16 ch in
 
-	let max_component_contours = rdu16 ch in
 
-	let max_zones = rdu16 ch in
 
-	let max_twilight_points = rdu16 ch in
 
-	let max_storage = rdu16 ch in
 
-	let max_function_defs = rdu16 ch in
 
-	let max_instruction_defs = rdu16 ch in
 
-	let max_stack_elements = rdu16 ch in
 
-	let max_size_of_instructions = rdu16 ch in
 
-	let max_component_elements = rdu16 ch in
 
-	let max_component_depth = rdu16 ch in
 
-	{
 
-		maxp_version_number = version_number;
 
-		maxp_num_glyphs = num_glyphs;
 
-		maxp_max_points = max_points;
 
-		maxp_max_contours = max_contours;
 
-		maxp_max_component_points = max_component_points;
 
-		maxp_max_component_contours = max_component_contours;
 
-		maxp_max_zones = max_zones;
 
-		maxp_max_twilight_points = max_twilight_points;
 
-		maxp_max_storage = max_storage;
 
-		maxp_max_function_defs = max_function_defs;
 
-		maxp_max_instruction_defs = max_instruction_defs;
 
-		maxp_max_stack_elements = max_stack_elements;
 
-		maxp_max_size_of_instructions = max_size_of_instructions;
 
-		maxp_max_component_elements = max_component_elements;
 
-		maxp_max_component_depth = max_component_depth;
 
-	}
 
-
 
-let parse_loca_table head maxp ctx =
 
-	let ch = ctx.ch in
 
-	if head.hd_index_to_loc_format = 0 then
 
-		Array.init (maxp.maxp_num_glyphs + 1) (fun _ -> Int32.of_int ((rdu16 ch) * 2))
 
-	else
 
-		Array.init (maxp.maxp_num_glyphs + 1) (fun _ -> rd32r ch)
 
-
 
-let parse_hmtx_table maxp hhea ctx =
 
-	let ch = ctx.ch in
 
-	let last_advance_width = ref 0 in (* check me 1/2*)
 
-	Array.init maxp.maxp_num_glyphs (fun i ->
 
-		let advance_width = if i > hhea.hhea_number_of_hmetrics-1 then (* check me 2/2*)
 
-			!last_advance_width
 
-		else
 
-			rdu16 ch
 
-		in
 
-		last_advance_width := advance_width;
 
-		let left_side_bearing = rd16 ch in
 
-		{
 
-			advance_width = advance_width;
 
-			left_side_bearing = left_side_bearing;
 
-		}
 
-	)
 
-
 
-let parse_cmap_table ctx =
 
-	let ch = ctx.ch in
 
-	let version = rdu16 ch in
 
-	let num_subtables = rdu16 ch in
 
-	let dir = ExtList.List.init num_subtables (fun _ ->
 
-		let platform_id = rdu16 ch in
 
-		let platform_specific_id = rdu16 ch in
 
-		let offset = rd32r ch in
 
-		{
 
-			csh_platform_id = platform_id;
 
-			csh_platform_specific_id = platform_specific_id;
 
-			csh_offset = offset;
 
-		}
 
-	) in
 
-	let dir = List.stable_sort (fun csh1 csh2 ->
 
-		if csh1.csh_platform_id < csh2.csh_platform_id then -1
 
-		else if csh1.csh_platform_id > csh2.csh_platform_id then 1
 
-		else compare csh1.csh_platform_specific_id csh2.csh_platform_specific_id
 
-	) dir in
 
-	let parse_sub entry =
 
-		seek_in ctx.file ((Int32.to_int ctx.entry.entry_offset) + (Int32.to_int entry.csh_offset));
 
-		let format = rdu16 ch in
 
-		let def = match format with
 
-			| 0 ->
 
-				let length = rdu16 ch in
 
-				let language = rdu16 ch in
 
-				let glyph_index = Array.init 256 (fun _ -> read ch) in
 
-				Cmap0 {
 
-					c0_format = 0;
 
-					c0_length = length;
 
-					c0_language = language;
 
-					c0_glyph_index_array = glyph_index;
 
-				}
 
-			| 4 ->
 
-				let length = rdu16 ch in
 
-				let language = rdu16 ch in
 
-				let seg_count_x2 = rdu16 ch in
 
-				let seg_count = seg_count_x2 / 2 in
 
-				let search_range = rdu16 ch in
 
-				let entry_selector = rdu16 ch in
 
-				let range_shift = rdu16 ch in
 
-				let end_code = Array.init seg_count (fun _ -> rdu16 ch) in
 
-				let reserved = rdu16 ch in
 
-				assert (reserved = 0);
 
-				let start_code = Array.init seg_count (fun _ -> rdu16 ch) in
 
-				let id_delta = Array.init seg_count (fun _ -> rdu16 ch) in
 
-				let id_range_offset = Array.init seg_count (fun _ -> rdu16 ch) in
 
-				let count = (length - (8 * seg_count + 16)) / 2 in
 
-				let glyph_index = Array.init count (fun _ -> rdu16 ch) in
 
-				Cmap4 {
 
-					c4_format = format;
 
-					c4_length = length;
 
-					c4_language = language;
 
-					c4_seg_count_x2 = seg_count_x2;
 
-					c4_search_range = search_range;
 
-					c4_entry_selector = entry_selector;
 
-					c4_range_shift = range_shift;
 
-					c4_end_code = end_code;
 
-					c4_reserved_pad = reserved;
 
-					c4_start_code = start_code;
 
-					c4_id_delta = id_delta;
 
-					c4_id_range_offset = id_range_offset;
 
-					c4_glyph_index_array = glyph_index;
 
-				}
 
-			| 6 ->
 
-				let length = rdu16 ch in
 
-				let language = rdu16 ch in
 
-				let first_code = rdu16 ch in
 
-				let entry_count = rdu16 ch in
 
-				let glyph_index = Array.init entry_count (fun _ -> rdu16 ch) in
 
-				Cmap6 {
 
-					c6_format = format;
 
-					c6_length = length;
 
-					c6_language = language;
 
-					c6_first_code = first_code;
 
-					c6_entry_count = entry_count;
 
-					c6_glyph_index_array = glyph_index;
 
-				}
 
-  			| 12 ->
 
-				ignore (rd16 ch);
 
-				let length = rd32r ch in
 
-				let language = rd32r ch in
 
-				let num_groups = rd32r ch in
 
-				let groups = ExtList.List.init (Int32.to_int num_groups) (fun _ ->
 
-					let start = rd32r ch in
 
-					let stop = rd32r ch in
 
-					let start_glyph = rd32r ch in
 
-					{
 
-						c12g_start_char_code = start;
 
-						c12g_end_char_code = stop;
 
-						c12g_start_glyph_code = start_glyph;
 
-					}
 
-				) in
 
-				Cmap12 {
 
-					c12_format = Int32.of_int 12;
 
-					c12_length = length;
 
-					c12_language = language;
 
-					c12_num_groups = num_groups;
 
-					c12_groups = groups;
 
-				}
 
-			| x ->
 
-				failwith ("Not implemented format: " ^ (string_of_int x));
 
-		in
 
-		{
 
-			cs_def = def;
 
-			cs_header = entry;
 
-		}
 
-
 
-	in
 
-	{
 
-		cmap_version = version;
 
-		cmap_num_subtables = num_subtables;
 
-		cmap_subtables = List.map parse_sub dir;
 
-	}
 
-
 
-let parse_glyf_table maxp loca cmap hmtx ctx =
 
-	let ch = ctx.ch in
 
-	let parse_glyf i =
 
-		seek_in ctx.file ((Int32.to_int ctx.entry.entry_offset) + (Int32.to_int loca.(i)));
 
-		let num_contours = rd16 ch in
 
-		let xmin = rd16 ch in
 
-		let ymin = rd16 ch in
 
-		let xmax = rd16 ch in
 
-		let ymax = rd16 ch in
 
-		let header = {
 
-			gh_num_contours = num_contours;
 
-			gh_xmin = xmin;
 
-			gh_ymin = ymin;
 
-			gh_xmax = xmax;
 
-			gh_ymax = ymax;
 
-		} in
 
-		if num_contours >= 0 then begin
 
-			let num_points = ref 0 in
 
-			let end_pts_of_contours = Array.init num_contours (fun i ->
 
-				let v = rdu16 ch in
 
-				if i = num_contours - 1 then num_points := v + 1;
 
-				v
 
-			) in
 
-			let instruction_length = rdu16 ch in
 
-			let instructions = Array.init instruction_length (fun _ ->
 
-				read ch
 
-			) in
 
-			let flags = DynArray.create () in
 
-			let rec loop index =
 
-				if index >= !num_points then () else begin
 
-					let v = read_byte ch in
 
-					let incr = if (v land 8) == 0 then begin
 
-						DynArray.add flags v;
 
-						1
 
-					end else begin
 
-						let r = (int_of_char (read ch)) in
 
-						for i = 0 to r do DynArray.add flags v done;
 
-						r + 1
 
-					end in
 
-					loop (index + incr)
 
-				end
 
-			in
 
-			loop 0;
 
-			assert (DynArray.length flags = !num_points);
 
-			let x_coordinates = Array.init !num_points (fun i ->
 
-				let flag = DynArray.get flags i in
 
-				if flag land 0x10 <> 0 then begin
 
-					if flag land 0x02 <> 0 then read_byte ch
 
-					else 0
 
-				end else begin
 
-					if flag land 0x02 <> 0 then -read_byte ch
 
-					else rd16 ch
 
-				end
 
-			) in
 
-			let y_coordinates = Array.init !num_points (fun i ->
 
-				let flag = DynArray.get flags i in
 
-				if flag land 0x20 <> 0 then begin
 
-					if flag land 0x04 <> 0 then read_byte ch
 
-					else 0
 
-				end else begin
 
-					if flag land 0x04 <> 0 then -read_byte ch
 
-					else rd16 ch
 
-				end;
 
-			) in
 
-			TGlyfSimple (header, {
 
-				gs_end_pts_of_contours = end_pts_of_contours;
 
-				gs_instruction_length = instruction_length;
 
-				gs_instructions = instructions;
 
-				gs_flags = DynArray.to_array flags;
 
-				gs_x_coordinates = x_coordinates;
 
-				gs_y_coordinates = y_coordinates;
 
-			})
 
-		end else if num_contours = -1 then begin
 
-			let acc = DynArray.create () in
 
-			let rec loop () =
 
-				let flags = rdu16 ch in
 
-				let glyph_index = rdu16 ch in
 
-				let arg1,arg2 = if flags land 1 <> 0 then begin
 
-					let arg1 = rd16 ch in
 
-					let arg2 = rd16 ch in
 
-					arg1,arg2
 
-				end else begin
 
-					let arg1 = read_byte ch in
 
-					let arg2 = read_byte ch in
 
-					arg1,arg2
 
-				end in
 
-				let fmt214 i = (float_of_int i) /. (float_of_int 0x4000) in
 
-				let fmode =	if flags land 8 <> 0 then
 
-					Scale (fmt214 (rd16 ch))
 
-				else if flags land 64 <> 0 then begin
 
-					let s1 = fmt214 (rd16 ch) in
 
-					let s2 = fmt214 (rd16 ch) in
 
-					ScaleXY (s1,s2)
 
-				end else if flags land 128 <> 0 then begin
 
-					let a = fmt214 (rd16 ch) in
 
-					let b = fmt214 (rd16 ch) in
 
-					let c = fmt214 (rd16 ch) in
 
-					let d = fmt214 (rd16 ch) in
 
-					ScaleMatrix (a,b,c,d)
 
-				end else
 
-					NoScale
 
-				in
 
-				DynArray.add acc {
 
-					gc_flags = flags;
 
-					gc_glyf_index = glyph_index;
 
-					gc_arg1 = if flags land 2 <> 0 then arg1 else 0;
 
-					gc_arg2 = if flags land 2 <> 0 then arg2 else 0;
 
-					gc_transformation = fmode;
 
-				};
 
-				if flags land 0x20 <> 0 then loop ();
 
-			in
 
-			loop ();
 
-			TGlyfComposite (header,(DynArray.to_list acc))
 
-		end else
 
-			failwith "Unknown Glyf"
 
-	in
 
-	Array.init maxp.maxp_num_glyphs (fun i ->
 
-		let len = (Int32.to_int loca.(i + 1)) - (Int32.to_int loca.(i)) in
 
-		if len > 0 then parse_glyf i else TGlyfNull
 
-	)
 
-
 
-let parse_kern_table ctx =
 
-	let ch = ctx.ch in
 
-	let version = Int32.of_int (rd16 ch) in
 
-	let num_tables = Int32.of_int (rd16 ch) in
 
-	let tables = ExtList.List.init (Int32.to_int num_tables) (fun _ ->
 
-		let length = Int32.of_int (rdu16 ch) in
 
-		let tuple_index = rdu16 ch in
 
-		let coverage = rdu16 ch in
 
-		let def = match coverage lsr 8 with
 
-		| 0 ->
 
-			let num_pairs = rdu16 ch in
 
-			let search_range = rdu16 ch in
 
-			let entry_selector = rdu16 ch in
 
-			let range_shift = rdu16 ch in
 
-			let kerning_pairs = ExtList.List.init num_pairs (fun _ ->
 
-				let left = rdu16 ch in
 
-				let right = rdu16 ch in
 
-				let value = rd16 ch in
 
-				{
 
-					kern_left = left;
 
-					kern_right = right;
 
-					kern_value = value;
 
-				}
 
-			) in
 
-			Kern0 {
 
-				k0_num_pairs = num_pairs;
 
-				k0_search_range = search_range;
 
-				k0_entry_selector = entry_selector;
 
-				k0_range_shift = range_shift;
 
-				k0_pairs = kerning_pairs;
 
-			}
 
-		| 2 ->
 
-			let row_width = rdu16 ch in
 
-			let left_offset_table = rdu16 ch in
 
-			let right_offset_table = rdu16 ch in
 
-			let array_offset = rdu16 ch in
 
-			let first_glyph = rdu16 ch in
 
-			let num_glyphs = rdu16 ch in
 
-			let offsets = ExtList.List.init num_glyphs (fun _ ->
 
-				rdu16 ch
 
-			) in
 
-			Kern2 {
 
-				k2_row_width = row_width;
 
-				k2_left_offset_table = left_offset_table;
 
-				k2_right_offset_table = right_offset_table;
 
-				k2_array = array_offset;
 
-				k2_first_glyph = first_glyph;
 
-				k2_num_glyphs = num_glyphs;
 
-				k2_offsets = offsets;
 
-			}
 
-		| i ->
 
-			failwith ("Unknown kerning: " ^ (string_of_int i));
 
-		in
 
-		{
 
-			ks_def = def;
 
-			ks_header = {
 
-				ksh_length = length;
 
-				ksh_coverage = coverage;
 
-				ksh_tuple_index = tuple_index;
 
-			}
 
-		}
 
-	) in
 
-	{
 
-		kern_version = version;
 
-		kern_num_tables = num_tables;
 
-		kern_subtables = tables;
 
-	}
 
-
 
-let parse_name_table ctx =
 
-	let ch = ctx.ch in
 
-	let format = rdu16 ch in
 
-	let num_records = rdu16 ch in
 
-	let offset = rdu16 ch in
 
-	let records = Array.init num_records (fun _ ->
 
-		let platform_id = rdu16 ch in
 
-		let platform_specific_id = rdu16 ch in
 
-		let language_id = rdu16 ch in
 
-		let name_id = rdu16 ch in
 
-		let length = rdu16 ch in
 
-		let offset = rdu16 ch in
 
-		{
 
-			nr_platform_id = platform_id;
 
-			nr_platform_specific_id = platform_specific_id;
 
-			nr_language_id = language_id;
 
-			nr_name_id = name_id;
 
-			nr_length = length;
 
-			nr_offset = offset;
 
-			nr_value = "";
 
-		}
 
-	) in
 
-	let ttf_name = ref "" in
 
-	(* TODO: use real utf16 conversion *)
 
-	let set_name n =
 
-		let l = ExtList.List.init (String.length n / 2) (fun i -> String.make 1 n.[i * 2 + 1]) in
 
-		ttf_name := String.concat "" l
 
-	in
 
-	let records = Array.map (fun r ->
 
-		seek_in ctx.file ((Int32.to_int ctx.entry.entry_offset) + offset + r.nr_offset);
 
-		r.nr_value <- nread_string ch r.nr_length;
 
-		if r.nr_name_id = 4 && r.nr_platform_id = 3 || r.nr_platform_id = 0 then set_name r.nr_value;
 
-		r
 
-	) records in
 
-	{
 
-		name_format = format;
 
-		name_num_records = num_records;
 
-		name_offset = offset;
 
-		name_records = records;
 
-	},!ttf_name
 
-
 
-let parse_os2_table ctx =
 
-	let ch = ctx.ch in
 
-	let version = rdu16 ch in
 
-	let x_avg_char_width = rd16 ch in
 
-	let us_weight_class = rdu16 ch in
 
-	let us_width_class = rdu16 ch in
 
-	let fs_type = rd16 ch in
 
-	let y_subscript_x_size = rd16 ch in
 
-	let y_subscript_y_size = rd16 ch in
 
-	let y_subscript_x_offset = rd16 ch in
 
-	let y_subscript_y_offset = rd16 ch in
 
-	let y_superscript_x_size = rd16 ch in
 
-	let y_superscript_y_size = rd16 ch in
 
-	let y_superscript_x_offset = rd16 ch in
 
-	let y_superscript_y_offset = rd16 ch in
 
-	let y_strikeout_size = rd16 ch in
 
-	let y_strikeout_position = rd16 ch in
 
-	let s_family_class = rd16 ch in
 
-
 
-	let b_family_type = read_byte ch in
 
-	let b_serif_style = read_byte ch in
 
-	let b_weight = read_byte ch in
 
-	let b_proportion = read_byte ch in
 
-	let b_contrast = read_byte ch in
 
-	let b_stroke_variation = read_byte ch in
 
-	let b_arm_style = read_byte ch in
 
-	let b_letterform = read_byte ch in
 
-	let b_midline = read_byte ch in
 
-	let b_x_height = read_byte ch in
 
-
 
-	let ul_unicode_range_1 = rd32r ch in
 
-	let ul_unicode_range_2 = rd32r ch in
 
-	let ul_unicode_range_3 = rd32r ch in
 
-	let ul_unicode_range_4 = rd32r ch in
 
-	let ach_vendor_id = rd32r ch in
 
-	let fs_selection = rd16 ch in
 
-	let us_first_char_index = rdu16 ch in
 
-	let us_last_char_index = rdu16 ch in
 
-	let s_typo_ascender = rd16 ch in
 
-	let s_typo_descender = rd16 ch in
 
-	let s_typo_line_gap = rd16 ch in
 
-	let us_win_ascent = rdu16 ch in
 
-	let us_win_descent = rdu16 ch in
 
-	{
 
-		os2_version = version;
 
-		os2_x_avg_char_width = x_avg_char_width;
 
-		os2_us_weight_class = us_weight_class;
 
-		os2_us_width_class = us_width_class;
 
-		os2_fs_type = fs_type;
 
-		os2_y_subscript_x_size = y_subscript_x_size;
 
-		os2_y_subscript_y_size = y_subscript_y_size;
 
-		os2_y_subscript_x_offset = y_subscript_x_offset;
 
-		os2_y_subscript_y_offset = y_subscript_y_offset;
 
-		os2_y_superscript_x_size = y_superscript_x_size;
 
-		os2_y_superscript_y_size = y_superscript_y_size;
 
-		os2_y_superscript_x_offset = y_superscript_x_offset;
 
-		os2_y_superscript_y_offset = y_superscript_y_offset;
 
-		os2_y_strikeout_size = y_strikeout_size;
 
-		os2_y_strikeout_position = y_strikeout_position;
 
-		os2_s_family_class = s_family_class;
 
-		os2_b_family_type = b_family_type;
 
-		os2_b_serif_style = b_serif_style;
 
-		os2_b_weight = b_weight;
 
-		os2_b_proportion = b_proportion;
 
-		os2_b_contrast = b_contrast;
 
-		os2_b_stroke_variation = b_stroke_variation;
 
-		os2_b_arm_style = b_arm_style;
 
-		os2_b_letterform = b_letterform;
 
-		os2_b_midline = b_midline;
 
-		os2_b_x_height = b_x_height;
 
-		os2_ul_unicode_range_1 = ul_unicode_range_1;
 
-		os2_ul_unicode_range_2 = ul_unicode_range_2;
 
-		os2_ul_unicode_range_3 = ul_unicode_range_3;
 
-		os2_ul_unicode_range_4 = ul_unicode_range_4;
 
-		os2_ach_vendor_id = ach_vendor_id;
 
-		os2_fs_selection = fs_selection;
 
-		os2_us_first_char_index = us_first_char_index;
 
-		os2_us_last_char_index = us_last_char_index;
 
-		os2_s_typo_ascender = s_typo_ascender;
 
-		os2_s_typo_descender = s_typo_descender;
 
-		os2_s_typo_line_gap = s_typo_line_gap;
 
-		os2_us_win_ascent = us_win_ascent;
 
-		os2_us_win_descent = us_win_descent;
 
-	}
 
-
 
-let parse file : ttf =
 
-	let ctx = {
 
-		file = file;
 
-		ch = input_channel file;
 
-		entry = {
 
-			entry_table_name = "";
 
-			entry_offset = Int32.of_int 0;
 
-			entry_length = Int32.of_int 0;
 
-			entry_checksum = Int32.of_int 0;
 
-		}
 
-	} in
 
-	let header = parse_header ctx in
 
-	let directory = parse_directory ctx header in
 
-	let parse_table entry f =
 
-		seek_in file (Int32.to_int entry.entry_offset);
 
-		ctx.entry <- entry;
 
-		f ctx
 
-	in
 
-	let parse_req_table name f =
 
-		try
 
-			let entry = Hashtbl.find directory name in
 
-			parse_table entry f
 
-		with Not_found ->
 
-			failwith (Printf.sprintf "Required table %s could not be found" name)
 
-	in
 
-	let parse_opt_table name f =
 
-		try
 
-			let entry = Hashtbl.find directory name in
 
-			Some (parse_table entry f)
 
-		with Not_found ->
 
-			None
 
-	in
 
-	let head = parse_req_table "head" parse_head_table in
 
-	let hhea = parse_req_table "hhea" parse_hhea_table in
 
-	let maxp = parse_req_table "maxp" parse_maxp_table in
 
-	let loca = parse_req_table "loca" (parse_loca_table head maxp) in
 
-	let hmtx = parse_req_table "hmtx" (parse_hmtx_table maxp hhea) in
 
-	let cmap = parse_req_table "cmap" (parse_cmap_table) in
 
-	let glyfs = parse_req_table "glyf" (parse_glyf_table maxp loca cmap hmtx) in
 
-	let kern = parse_opt_table "kern" (parse_kern_table) in
 
-	let name,ttf_name = parse_req_table "name" (parse_name_table) in
 
-	let os2 = parse_req_table "OS/2" (parse_os2_table) in
 
-	{
 
-		ttf_header = header;
 
-		ttf_font_name = ttf_name;
 
-		ttf_directory = directory;
 
-		ttf_head = head;
 
-		ttf_hhea = hhea;
 
-		ttf_maxp = maxp;
 
-		ttf_loca = loca;
 
-		ttf_hmtx = hmtx;
 
-		ttf_cmap = cmap;
 
-		ttf_glyfs = glyfs;
 
-		ttf_name = name;
 
-		ttf_os2 = os2;
 
-		ttf_kern = kern;
 
-	}

+ 0 - 211
libs/ttflib/tTFSwfWriter.ml
Ver Ficheiro 

@@ -1,211 +0,0 @@
 
-(*
 
- * Copyright (C)2005-2014 Haxe Foundation
 
- *
 
- * Permission is hereby granted, free of charge, to any person obtaining a
 
- * copy of this software and associated documentation files (the "Software"),
 
- * to deal in the Software without restriction, including without limitation
 
- * the rights to use, copy, modify, merge, publish, distribute, sublicense,
 
- * and/or sell copies of the Software, and to permit persons to whom the
 
- * Software is furnished to do so, subject to the following conditions:
 
- *
 
- * The above copyright notice and this permission notice shall be included in
 
- * all copies or substantial portions of the Software.
 
- *
 
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 
- * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 
- * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
 
- * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
 
- * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 
- * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
 
- * DEALINGS IN THE SOFTWARE.
 
- *)
 
-
 
-open TTFData
 
-open Swf
 
-
 
-let num_bits x =
 
-	if x = 0 then
 
-		0
 
-	else
 
-		let rec loop n v =
 
-			if v = 0 then n else loop (n + 1) (v lsr 1)
 
-		in
 
-		loop 1 (abs x)
 
-
 
-let round x = int_of_float (floor (x +. 0.5))
 
-
 
-let to_twips v = round (v *. 20.)
 
-
 
-type ctx = {
 
-	ttf : ttf;
 
-}
 
-
 
-let begin_fill =
 
-	SRStyleChange {
 
-		scsr_move = None;
 
-		scsr_fs0 = Some(1);
 
-		scsr_fs1 = None;
 
-		scsr_ls = None;
 
-		scsr_new_styles = None;
 
-	}
 
-
 
-let end_fill =
 
-	SRStyleChange {
 
-		scsr_move = None;
 
-		scsr_fs0 = None;
 
-		scsr_fs1 = None;
 
-		scsr_ls = None;
 
-		scsr_new_styles = None;
 
-	}
 
-
 
-let align_bits x nbits = x land ((1 lsl nbits ) - 1)
 
-
 
-let move_to ctx x y =
 
-	let x = to_twips x in
 
-	let y = to_twips y in
 
-	let nbits = max (num_bits x) (num_bits y) in
 
-	SRStyleChange {
 
-		scsr_move = Some (nbits, align_bits x nbits, align_bits y nbits);
 
-		scsr_fs0 = Some(1);
 
-		scsr_fs1 = None;
 
-		scsr_ls = None;
 
-		scsr_new_styles = None;
 
-	}
 
-
 
-let line_to ctx x y =
 
-	let x = to_twips x in
 
-	let y = to_twips y in
 
-	if x = 0 && y = 0 then raise Exit;
 
-	let nbits = max (num_bits x) (num_bits y) in
 
-	SRStraightEdge {
 
-		sser_nbits = nbits;
 
-		sser_line = (if x = 0 then None else Some(align_bits x nbits)), (if y = 0 then None else Some(align_bits y nbits));
 
-	}
 
-
 
-let curve_to ctx cx cy ax ay =
 
-	let cx = to_twips cx in
 
-	let cy = to_twips cy in
 
-	let ax = to_twips ax in
 
-	let ay = to_twips ay in
 
-	let nbits = max (max (num_bits cx) (num_bits cy)) (max (num_bits ax) (num_bits ay)) in
 
-	SRCurvedEdge {
 
-		scer_nbits = nbits;
 
-		scer_cx = align_bits cx nbits;
 
-		scer_cy = align_bits cy nbits;
 
-		scer_ax = align_bits ax nbits;
 
-		scer_ay = align_bits ay nbits;
 
-	}
 
-
 
-open TTFTools
 
-
 
-let write_paths ctx paths =
 
-	let scale = 1024. /. (float_of_int ctx.ttf.ttf_head.hd_units_per_em) in
 
-	let srl = DynArray.create () in
 
-	List.iter (fun path ->
 
-		try
 
-			DynArray.add srl (match path.gp_type with
 
-			| 0 -> move_to ctx (path.gp_x *. scale) ((-1.) *. path.gp_y *. scale);
 
-			| 1 -> line_to ctx (path.gp_x *. scale) ((-1.) *. path.gp_y *. scale);
 
-			| 2 -> curve_to ctx (path.gp_cx *. scale) ((-1.) *. path.gp_cy *. scale) (path.gp_x *. scale) ((-1.) *. path.gp_y *. scale);
 
-			| _ -> assert false)
 
-		with Exit ->
 
-			()
 
-	) paths;
 
-	DynArray.add srl (end_fill);
 
-	{
 
-		srs_nfbits = 1;
 
-		srs_nlbits = 0;
 
-		srs_records = DynArray.to_list srl;
 
-	}
 
-
 
-let rec write_glyph ctx key glyf =
 
-	{
 
-		font_char_code = key;
 
-		font_shape = write_paths ctx (TTFTools.build_glyph_paths ctx.ttf true glyf);
 
-	}
 
-
 
-let write_font_layout ctx lut =
 
-	let scale = 1024. /. (float_of_int ctx.ttf.ttf_head.hd_units_per_em) in
 
-	let hmtx = Hashtbl.fold (fun k v acc -> (k,ctx.ttf.ttf_hmtx.(v)) :: acc) lut [] in
 
-	let hmtx = List.stable_sort (fun a b -> compare (fst a) (fst b)) hmtx in
 
-	let hmtx = List.map (fun (k,g) -> g) hmtx in
 
-	{
 
-			font_ascent = round((float_of_int ctx.ttf.ttf_os2.os2_us_win_ascent) *. scale *. 20.);
 
-			font_descent = round((float_of_int ctx.ttf.ttf_os2.os2_us_win_descent) *. scale *. 20.);
 
-			font_leading = round(((float_of_int(ctx.ttf.ttf_os2.os2_us_win_ascent + ctx.ttf.ttf_os2.os2_us_win_descent - ctx.ttf.ttf_head.hd_units_per_em)) *. scale) *. 20.);
 
-			font_glyphs_layout = Array.of_list( ExtList.List.mapi (fun i h ->
 
-			{
 
-				font_advance = round((float_of_int h.advance_width) *. scale *. 20.);
 
-				font_bounds = {rect_nbits=0; left=0; right=0; top=0; bottom=0};
 
-			}) hmtx );
 
-			font_kerning = [];
 
-	}
 
-
 
-let bi v = if v then 1 else 0
 
-
 
-let int_from_langcode lc =
 
-	match lc with
 
-	| LCNone -> 0
 
-	| LCLatin -> 1
 
-	| LCJapanese -> 2
 
-	| LCKorean -> 3
 
-	| LCSimplifiedChinese -> 4
 
-	| LCTraditionalChinese -> 5
 
-
 
-let write_font2 ch b f2 =
 
-	IO.write_bits b 1 (bi true);
 
-	IO.write_bits b 1 (bi f2.font_shift_jis);
 
-	IO.write_bits b 1 (bi f2.font_is_small);
 
-	IO.write_bits b 1 (bi f2.font_is_ansi);
 
-	IO.write_bits b 1 (bi f2.font_wide_offsets);
 
-	IO.write_bits b 1 (bi f2.font_wide_codes);
 
-	IO.write_bits b 1 (bi f2.font_is_italic);
 
-	IO.write_bits b 1 (bi f2.font_is_bold);
 
-	IO.write_byte ch (int_from_langcode f2.font_language);
 
-	IO.write_byte ch ((String.length f2.font_name) + 1);
 
-	IO.nwrite_string ch f2.font_name;
 
-	IO.write_byte ch 0;
 
-	IO.write_ui16 ch (Array.length f2.font_glyphs);
 
-	let glyph_offset = ref (((Array.length f2.font_glyphs) * 4)+4) in
 
-	Array.iter (fun g ->
 
-		IO.write_i32 ch !glyph_offset;
 
-		glyph_offset := !glyph_offset + SwfParser.font_shape_records_length g.font_shape;
 
-	)f2.font_glyphs;
 
-	IO.write_i32 ch !glyph_offset;
 
-	Array.iter (fun g -> SwfParser.write_shape_without_style ch g.font_shape;) f2.font_glyphs;
 
-	Array.iter (fun g -> IO.write_ui16 ch g.font_char_code; )f2.font_glyphs;
 
-	IO.write_i16 ch f2.font_layout.font_ascent;
 
-	IO.write_i16 ch f2.font_layout.font_descent;
 
-	IO.write_i16 ch f2.font_layout.font_leading;
 
-	Array.iter (fun g ->
 
-		let fa = ref g.font_advance in
 
-		if (!fa) <  -32767 then fa := -32768;(* fix or check *)
 
-		if (!fa) > 32766 then fa := 32767;
 
-		IO.write_i16 ch !fa;) f2.font_layout.font_glyphs_layout;
 
-	Array.iter (fun g -> SwfParser.write_rect ch g.font_bounds;) f2.font_layout.font_glyphs_layout;
 
-	IO.write_ui16 ch 0 (* TODO: optional FontKerningTable *)
 
-
 
-let to_swf ttf config =
 
-	let ctx = {
 
-		ttf = ttf;
 
-	} in
 
-	let lut = TTFTools.build_lut ttf config.ttfc_range_str in
 
-	let glyfs = Hashtbl.fold (fun k v acc -> (k,ctx.ttf.ttf_glyfs.(v)) :: acc) lut [] in
 
-	let glyfs = List.stable_sort (fun a b -> compare (fst a) (fst b)) glyfs in
 
-	let glyfs = List.map (fun (k,g) -> write_glyph ctx k g) glyfs in
 
-	let glyfs_font_layout = write_font_layout ctx lut in
 
-	let glyfs = Array.of_list glyfs in
 
-	{
 
-		font_shift_jis = false;
 
-		font_is_small = false;
 
-		font_is_ansi = false;
 
-		font_wide_offsets = true;
 
-		font_wide_codes = true;
 
-		font_is_italic = config.ttfc_font_posture = TFPItalic;
 
-		font_is_bold = config.ttfc_font_weight = TFWBold;
 
-		font_language = LCNone;
 
-		font_name = (match config.ttfc_font_name with Some s -> s | None -> ttf.ttf_font_name);
 
-		font_glyphs = glyfs;
 
-		font_layout = glyfs_font_layout;
 
-	}
 
-;;

+ 0 - 275
libs/ttflib/tTFTools.ml
Ver Ficheiro 

@@ -1,275 +0,0 @@
 
-(*
 
- * Copyright (C)2005-2014 Haxe Foundation
 
- *
 
- * Permission is hereby granted, free of charge, to any person obtaining a
 
- * copy of this software and associated documentation files (the "Software"),
 
- * to deal in the Software without restriction, including without limitation
 
- * the rights to use, copy, modify, merge, publish, distribute, sublicense,
 
- * and/or sell copies of the Software, and to permit persons to whom the
 
- * Software is furnished to do so, subject to the following conditions:
 
- *
 
- * The above copyright notice and this permission notice shall be included in
 
- * all copies or substantial portions of the Software.
 
- *
 
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 
- * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 
- * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
 
- * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
 
- * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 
- * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
 
- * DEALINGS IN THE SOFTWARE.
 
- *)
 
-open Extlib_leftovers
 
-open TTFData
 
-
 
-type glyf_transformation_matrix = {
 
-	mutable a : float;
 
-	mutable b : float;
 
-	mutable c : float;
 
-	mutable d : float;
 
-	mutable tx : float;
 
-	mutable ty : float;
 
-}
 
-
 
-type glyf_path = {
 
-	gp_type : int;
 
-	gp_x : float;
 
-	gp_y : float;
 
-	gp_cx : float;
 
-	gp_cy : float;
 
-}
 
-
 
-type simple_point = {
 
-	x : float;
 
-	y : float;
 
-}
 
-
 
-let mk_path t x y cx cy = {
 
-	gp_type = t;
 
-	gp_x = x;
 
-	gp_y = y;
 
-	gp_cx = cx;
 
-	gp_cy = cy;
 
-}
 
-
 
-let identity () = {
 
-	a = 1.0;
 
-	b = 0.0;
 
-	c = 0.0;
 
-	d = 1.0;
 
-	tx = 0.0;
 
-	ty = 0.0;
 
-}
 
-
 
-let multiply m x y =
 
-	x *. m.a +. y *. m.b +. m.tx,
 
-	x *. m.c +. y *. m.d +. m.ty
 
-
 
-(* TODO: check if this can be done in the parser directly *)
 
-let matrix_from_composite gc =
 
-	let a,b,c,d = match gc.gc_transformation with
 
-		| NoScale -> 1.0,0.0,0.0,1.0
 
-		| Scale f -> f,0.0,0.0,f
 
-		| ScaleXY(fx,fy) -> fx,0.0,0.0,fy
 
-		| ScaleMatrix (a,b,c,d) -> a,b,c,d
 
-	in
 
-	let arg1 = float_of_int gc.gc_arg1 in
 
-	let arg2 = float_of_int gc.gc_arg2 in
 
-	{
 
-		a = a;
 
-		b = b;
 
-		c = c;
 
-		d = d;
 
-		(* TODO: point offsets *)
 
-		tx = arg1 *. a +. arg2 *. b;
 
-		ty = arg1 *. c +. arg2 *. d;
 
-	}
 
-
 
-let relative_matrix m = {m with tx = 0.0; ty = 0.0}
 
-
 
-let make_coords relative mo g = match mo with
 
-	| None ->
 
-		Array.init (Array.length g.gs_x_coordinates) (fun i -> float_of_int g.gs_x_coordinates.(i),float_of_int g.gs_y_coordinates.(i))
 
-	| Some m ->
 
-		let m = if relative then relative_matrix m else m in
 
-		Array.init (Array.length g.gs_x_coordinates) (fun i ->
 
-			let x,y = float_of_int g.gs_x_coordinates.(i),float_of_int g.gs_y_coordinates.(i) in
 
-			multiply m x y
 
-		)
 
-
 
-let build_paths relative mo g =
 
-	let len = Array.length g.gs_x_coordinates in
 
-	let current_end = ref 0 in
 
-	let end_pts = Array.init len (fun i ->
 
-		if g.gs_end_pts_of_contours.(!current_end) = i then begin
 
-			incr current_end;
 
-			true
 
-		end else
 
-			false
 
-	) in
 
-	let is_on i = g.gs_flags.(i) land 0x01 <> 0 in
 
-	let is_end i = end_pts.(i) in
 
-	let arr = DynArray.create () in
 
-	let tx,ty = match mo with None -> 0.0,0.0 | Some m -> m.tx,m.ty in
 
-	let last_added = ref {
 
-		x = 0.0;
 
-		y = 0.0;
 
-	} in
 
-	let add_rel t x y cx cy =
 
-		let p = match t with
 
-			| 0 ->
 
-				mk_path t (x +. tx) (y +. ty) cx cy
 
-			| 1 ->
 
-				mk_path t (x -. !last_added.x) (y -. !last_added.y) cx cy
 
-			| 2 ->
 
-				mk_path t (x -. cx) (y -. cy) (cx -. !last_added.x) (cy -. !last_added.y)
 
-			| _ ->
 
-				assert false
 
-		in
 
-		last_added := { x = x; y = y; };
 
-		DynArray.add arr p
 
-	in
 
-	let add_abs t x y cx cy = DynArray.add arr (mk_path t x y cx cy) in
 
-	let add = if relative then add_rel else add_abs in
 
-	let coords = make_coords relative mo g in
 
-
 
-	let left = ref [] in
 
-	let right = ref [] in
 
-	let new_contour = ref true in
 
-	let p = ref { x = 0.0; y = 0.0 } in
 
-	for i = 0 to len - 1 do
 
-		p := {
 
-			x = !p.x +. fst coords.(i);
 
-			y = !p.y +. snd coords.(i);
 
-		};
 
-		let p = !p in
 
-		let is_on = is_on i in
 
-		let is_end = is_end i in
 
-		let rec flush pl = match pl with
 
-			| c :: a :: [] -> add 2 a.x a.y c.x c.y
 
-			| a :: [] -> add 1 a.x a.y 0.0 0.0
 
-			| c1 :: c2 :: pl ->
 
-				add 2 (c1.x +. (c2.x -. c1.x) /. 2.0) (c1.y +. (c2.y -. c1.y) /. 2.0) c1.x c1.y;
 
-				flush (c2 :: pl)
 
-			| _ ->
 
-				Printf.printf "Fail, len: %i\n" (List.length pl);
 
-		in
 
-		if !new_contour then begin
 
-			if is_on then begin
 
-				new_contour := false;
 
-				add 0 p.x p.y 0.0 0.0;
 
-			end;
 
-			left := p :: !left
 
-		end else if is_on || is_end then begin
 
-			right := p :: !right;
 
-			if is_on then begin
 
-				flush (List.rev !right);
 
-				right := []
 
-			end;
 
-			if is_end then begin
 
-				new_contour := true;
 
-				flush ((List.rev !right) @ (List.rev !left));
 
-				left := [];
 
-				right := [];
 
-			end
 
-		end else
 
-			right := p :: !right
 
-	done;
 
-	DynArray.to_list arr
 
-
 
-let rec build_glyph_paths ttf relative ?(transformation=None) glyf =
 
-	match glyf with
 
-	| TGlyfSimple (h,g) ->
 
-		build_paths relative transformation g
 
-	| TGlyfComposite (h,gl) ->
 
-		List.concat (List.map (fun g ->
 
-			let t = Some (matrix_from_composite g) in
 
-			build_glyph_paths ttf relative ~transformation:t (ttf.ttf_glyfs.(g.gc_glyf_index))
 
-		) gl)
 
-	| TGlyfNull ->
 
-		[]
 
-
 
-let map_char_code cc c4 =
 
-	let index = ref 0 in
 
-	let seg_count = c4.c4_seg_count_x2 / 2 in
 
-	if cc >= 0xFFFF then 0 else begin
 
-		for i = 0 to seg_count - 1 do
 
-			if c4.c4_end_code.(i) >= cc && c4.c4_start_code.(i) <= cc then begin
 
-				if c4.c4_id_range_offset.(i) > 0 then
 
-					let v = c4.c4_id_range_offset.(i)/2 + cc - c4.c4_start_code.(i) - seg_count + i in
 
-					index := c4.c4_glyph_index_array.(v)
 
-				else
 
-					index := (c4.c4_id_delta.(i) + cc) mod 65536
 
-			end
 
-		done;
 
-		!index
 
-	end
 
-
 
-let parse_range_str str =
 
-	let last = ref (Char.code '\\') in
 
-	let range = ref false in
 
-	let lut = Hashtbl.create 0 in
 
-	UTF8.iter (fun code ->
 
-		let code = UCharExt.code code in
 
-		if code = Char.code '-' && !last <> Char.code '\\' then
 
-			range := true
 
-		else if !range then begin
 
-			range := false;
 
-			for i = !last to code do
 
-				Hashtbl.replace lut i true;
 
-			done;
 
-		end else begin
 
-			Hashtbl.replace lut code true;
 
-			last := code;
 
-		end
 
-	) str;
 
-	if !range then Hashtbl.replace lut (Char.code '-') true;
 
-	lut
 
-
 
-let build_lut ttf range_str =
 
-	let lut = Hashtbl.create 0 in
 
-	Hashtbl.add lut 0 0;
 
-	Hashtbl.add lut 1 1;
 
-	Hashtbl.add lut 2 2;
 
-	let add_character = if range_str = "" then
 
-			fun k v -> Hashtbl.replace lut k v
 
-		else begin
 
-			let range = parse_range_str range_str in
 
-			fun k v -> if Hashtbl.mem range k then Hashtbl.replace lut k v
 
-		end
 
-	in
 
-	let make_cmap4_map c4 =
 
-		let seg_count = c4.c4_seg_count_x2 / 2 in
 
-		for i = 0 to seg_count - 1 do
 
-			for j = c4.c4_start_code.(i) to c4.c4_end_code.(i) do
 
-				let index = map_char_code j c4 in
 
-				add_character j index;
 
-			done;
 
-		done
 
-	in
 
-(*  	let make_cmap12_map c12 =
 
-		List.iter (fun group ->
 
-			let rec loop cc gi =
 
-				add_character cc gi;
 
-				if cc < (Int32.to_int group.c12g_end_char_code) then loop (cc + 1) (gi + 1)
 
-			in
 
-			loop (Int32.to_int group.c12g_start_char_code) (Int32.to_int group.c12g_start_glyph_code)
 
-		) c12.c12_groups
 
-	in *)
 
-	List.iter (fun st -> match st.cs_def with
 
-		| Cmap0 c0 ->
 
-			Array.iteri (fun i c -> add_character i (int_of_char c)) c0.c0_glyph_index_array;
 
-		| Cmap4 c4 ->
 
-			make_cmap4_map c4;
 
-		| Cmap12 c12 ->
 
-			(*
 
-				TODO: this causes an exception with some fonts:
 
-				Fatal error: exception IO.Overflow("write_ui16")
 
-			*)
 
-			(* make_cmap12_map ctx lut c12; *)
 
-			()
 
-		| _ ->
 
-			(* TODO *)
 
-			()
 
-	) ttf.ttf_cmap.cmap_subtables;
 
-	lut

+ 1 - 1
src/dune
Ver Ficheiro 

@@ -17,7 +17,7 @@
 
 (library
 
 	(name haxe)
 
 	(libraries
 
-		extc extproc extlib_leftovers ilib javalib mbedtls neko objsize pcre2 camlp-streams swflib ttflib ziplib
 
+		extc extproc extlib_leftovers ilib javalib mbedtls neko objsize pcre2 camlp-streams swflib ziplib
 
 		json
 
 		unix ipaddr str bigarray threads dynlink
 
 		xml-light extlib sha terminal_size

+ 0 - 55
src/generators/genswf.ml
Ver Ficheiro 

@@ -222,8 +222,6 @@ let detect_format data p =
 
 	| _ ->
 
 		abort "Unknown file format" p
 
 
-open TTFData
 
-
 
 let build_swf9 com file swc =
 
 	let boot_name = if swc <> None || Common.defined com Define.HaxeBoot then "haxe" else "boot_" ^ (String.sub (Digest.to_hex (Digest.string (Filename.basename file))) 0 4) in
 
 	let code = Genswf9.generate com boot_name in
 
@@ -269,59 +267,6 @@ let build_swf9 com file swc =
 
 		| TClassDecl c ->
 
 			let rec loop = function
 
 				| [] -> acc
 
-				| (Meta.Font,(EConst (String(file,_)),p) :: args,_) :: l ->
 
-					let file = try Common.find_file com file with Not_found -> file in
 
-					let ch = try open_in_bin file with _ -> abort "File not found" p in
 
-					let ttf = try TTFParser.parse ch with e -> abort ("Error while parsing font " ^ file ^ " : " ^ Printexc.to_string e) p in
 
-					close_in ch;
 
-					let get_string e = match fst e with
 
-						| EConst (String(s,_)) -> s
 
-						| _ -> raise Not_found
 
-					in
 
-					let ttf_config = {
 
-						ttfc_range_str = "";
 
-						ttfc_font_name = None;
 
-						ttfc_font_weight = TFWRegular;
 
-						ttfc_font_posture = TFPNormal;
 
-					} in
 
-					begin match args with
 
-						| (EConst (String(str,_)),_) :: _ -> ttf_config.ttfc_range_str <- str;
 
-						| _ -> ()
 
-					end;
 
-					begin match args with
 
-						| _ :: [e] ->
 
-							begin match fst e with
 
-								| EObjectDecl fl ->
 
-									(try ttf_config.ttfc_font_name <- Some(get_string (Expr.field_assoc "fontName" fl)) with Not_found -> ());
 
-									(try ttf_config.ttfc_font_weight <- (
 
-										match get_string (Expr.field_assoc "fontWeight" fl) with
 
-										| "regular" -> TFWRegular
 
-										| "bold" -> TFWBold
 
-										| _ -> abort "Invalid fontWeight value. Must be `regular` or `bold`." p
 
-									) with Not_found -> ());
 
-									(try ttf_config.ttfc_font_posture <- (
 
-										match get_string (Expr.field_assoc "fontStyle" fl) with
 
-										| "normal" -> TFPNormal
 
-										| "italic" -> TFPItalic
 
-										| _ -> abort "Invalid fontStyle value. Must be `normal` or `italic`." p
 
-									) with Not_found -> ());
 
-								| _ ->
 
-									()
 
-							end
 
-						| _ ->
 
-							()
 
-					end;
 
-					let ttf_swf = TTFSwfWriter.to_swf ttf ttf_config in
 
-					let ch = IO.output_string () in
 
-					let b = IO.output_bits ch in
 
-					TTFSwfWriter.write_font2 ch b ttf_swf;
 
-					let data = IO.close_out ch in
 
-					incr cid;
 
-					classes := { f9_cid = Some !cid; f9_classname = s_type_path c.cl_path } :: !classes;
 
-					tag (TFont3 {
 
-						cd_id = !cid;
 
-						cd_data = data;
 
-					}) :: loop l
 
 				| (Meta.Bitmap,[EConst (String(file,_)),p],_) :: l ->
 
 					let data = load_file_data file p in
 
 					incr cid;