Browse Source

fix CRLF endings

Aurel Bílý 6 years ago
parent
commit
493446bea8

+ 23 - 23
libs/neko/Makefile

@@ -1,23 +1,23 @@
-OCAMLOPT=ocamlopt
-OCAMLC=ocamlc
-SRC=nast.ml nxml.ml binast.ml nbytecode.ml ncompile.ml
-
-all: bytecode native
-
-native: neko.cmxa
-
-bytecode: neko.cma
-
-neko.cmxa: $(SRC)
-	ocamlfind $(OCAMLOPT) -package extlib -safe-string -a -o neko.cmxa $(SRC)
-
-neko.cma: $(SRC)
-	ocamlfind $(OCAMLC) -package extlib -safe-string -a -o neko.cma $(SRC)
-
-clean:
-	rm -rf neko.cmxa neko.cma neko.lib neko.a $(wildcard *.cmx) $(wildcard *.obj) $(wildcard *.o) $(wildcard *.cmi) $(wildcard *.cmo)
-
-.PHONY: all bytecode native clean
-
-Makefile: ;
-$(SRC): ;
+OCAMLOPT=ocamlopt
+OCAMLC=ocamlc
+SRC=nast.ml nxml.ml binast.ml nbytecode.ml ncompile.ml
+
+all: bytecode native
+
+native: neko.cmxa
+
+bytecode: neko.cma
+
+neko.cmxa: $(SRC)
+	ocamlfind $(OCAMLOPT) -package extlib -safe-string -a -o neko.cmxa $(SRC)
+
+neko.cma: $(SRC)
+	ocamlfind $(OCAMLC) -package extlib -safe-string -a -o neko.cma $(SRC)
+
+clean:
+	rm -rf neko.cmxa neko.cma neko.lib neko.a $(wildcard *.cmx) $(wildcard *.obj) $(wildcard *.o) $(wildcard *.cmi) $(wildcard *.cmo)
+
+.PHONY: all bytecode native clean
+
+Makefile: ;
+$(SRC): ;

+ 66 - 66
libs/ocamake/ocamake.dsp

@@ -1,66 +1,66 @@
-# 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
+# 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

+ 29 - 29
libs/ocamake/ocamake.dsw

@@ -1,29 +1,29 @@
-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>
-{{{
-}}}
-
-###############################################################################
-
+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>
+{{{
+}}}
+
+###############################################################################
+

+ 81 - 81
libs/swflib/Makefile

@@ -1,81 +1,81 @@
-# Makefile generated by OCamake
-# http://tech.motion-twin.com
-OCAMLOPT=ocamlopt
-OCAMLC=ocamlc
-.SUFFIXES : .ml .mli .cmo .cmi .cmx .mll .mly
-
-ALL_CFLAGS= $(CFLAGS) -safe-string -package extlib -I ../extlib-leftovers -I ../extc -g
-LIBS=
-
-SRC=actionScript.ml as3hl.mli as3.mli png.ml swflib.sln swf.ml swfPic.ml as3code.ml as3hlparse.ml as3parse.ml png.mli swfParser.ml
-
-MODULES=as3code.cmx png.cmx swf.cmx actionScript.cmx as3parse.cmx swfPic.cmx as3hlparse.cmx swfParser.cmx
-
-all: native bytecode
-
-native: swflib.cmxa
-
-bytecode: swflib.cma
-
-swflib.cmxa: $(MODULES)
-	ocamlfind $(OCAMLOPT) -safe-string -o swflib.cmxa -a $(LIBS) $(MODULES)
-
-swflib.cma: $(MODULES:.cmx=.cmo)
-	ocamlfind $(OCAMLC) -safe-string -o swflib.cma -a $(LFLAGS) $(LIBS) $(MODULES:.cmx=.cmo)
-
-actionScript.cmx: swf.cmx
-
-actionScript.cmo: swf.cmi
-
-as3code.cmo: as3.cmi
-
-as3code.cmx: as3.cmi
-
-as3hl.cmi: as3.cmi
-
-as3hlparse.cmo: as3parse.cmo as3hl.cmi as3code.cmo as3.cmi
-
-as3hlparse.cmx: as3parse.cmx as3hl.cmi as3code.cmx as3.cmi
-
-as3parse.cmo: as3code.cmo as3.cmi
-
-as3parse.cmx: as3code.cmx as3.cmi
-
-png.cmo: png.cmi
-
-png.cmx: png.cmi
-
-swf.cmo: as3.cmi
-
-swf.cmx: as3.cmi
-
-swfParser.cmo: swf.cmo as3parse.cmo actionScript.cmo
-
-swfParser.cmx: swf.cmx as3parse.cmx actionScript.cmx
-
-swfPic.cmx: swf.cmx png.cmi
-
-clean:
-	rm -f swflib.cmxa swflib.cma swflib.lib swflib.a as3.cmi as3hl.cmi
-	rm -f $(MODULES) $(MODULES:.cmx=.obj) $(MODULES:.cmx=.cmi) $(MODULES:.cmx=.o) $(MODULES:.cmx=.cmo)
-
-# SUFFIXES
-.ml.cmo:
-	ocamlfind $(OCAMLC) $(ALL_CFLAGS) -c $<
-
-.ml.cmx:
-	ocamlfind $(OCAMLOPT) $(ALL_CFLAGS) -c $<
-
-.mli.cmi:
-	ocamlfind $(OCAMLC) $(ALL_CFLAGS) $<
-
-.mll.ml:
-	ocamlfind ocamllex $<
-
-.mly.ml:
-	ocamlfind ocamlyacc $<
-
-.PHONY: all bytecode native clean
-
-Makefile: ;
-$(SRC): ;
+# Makefile generated by OCamake
+# http://tech.motion-twin.com
+OCAMLOPT=ocamlopt
+OCAMLC=ocamlc
+.SUFFIXES : .ml .mli .cmo .cmi .cmx .mll .mly
+
+ALL_CFLAGS= $(CFLAGS) -safe-string -package extlib -I ../extlib-leftovers -I ../extc -g
+LIBS=
+
+SRC=actionScript.ml as3hl.mli as3.mli png.ml swflib.sln swf.ml swfPic.ml as3code.ml as3hlparse.ml as3parse.ml png.mli swfParser.ml
+
+MODULES=as3code.cmx png.cmx swf.cmx actionScript.cmx as3parse.cmx swfPic.cmx as3hlparse.cmx swfParser.cmx
+
+all: native bytecode
+
+native: swflib.cmxa
+
+bytecode: swflib.cma
+
+swflib.cmxa: $(MODULES)
+	ocamlfind $(OCAMLOPT) -safe-string -o swflib.cmxa -a $(LIBS) $(MODULES)
+
+swflib.cma: $(MODULES:.cmx=.cmo)
+	ocamlfind $(OCAMLC) -safe-string -o swflib.cma -a $(LFLAGS) $(LIBS) $(MODULES:.cmx=.cmo)
+
+actionScript.cmx: swf.cmx
+
+actionScript.cmo: swf.cmi
+
+as3code.cmo: as3.cmi
+
+as3code.cmx: as3.cmi
+
+as3hl.cmi: as3.cmi
+
+as3hlparse.cmo: as3parse.cmo as3hl.cmi as3code.cmo as3.cmi
+
+as3hlparse.cmx: as3parse.cmx as3hl.cmi as3code.cmx as3.cmi
+
+as3parse.cmo: as3code.cmo as3.cmi
+
+as3parse.cmx: as3code.cmx as3.cmi
+
+png.cmo: png.cmi
+
+png.cmx: png.cmi
+
+swf.cmo: as3.cmi
+
+swf.cmx: as3.cmi
+
+swfParser.cmo: swf.cmo as3parse.cmo actionScript.cmo
+
+swfParser.cmx: swf.cmx as3parse.cmx actionScript.cmx
+
+swfPic.cmx: swf.cmx png.cmi
+
+clean:
+	rm -f swflib.cmxa swflib.cma swflib.lib swflib.a as3.cmi as3hl.cmi
+	rm -f $(MODULES) $(MODULES:.cmx=.obj) $(MODULES:.cmx=.cmi) $(MODULES:.cmx=.o) $(MODULES:.cmx=.cmo)
+
+# SUFFIXES
+.ml.cmo:
+	ocamlfind $(OCAMLC) $(ALL_CFLAGS) -c $<
+
+.ml.cmx:
+	ocamlfind $(OCAMLOPT) $(ALL_CFLAGS) -c $<
+
+.mli.cmi:
+	ocamlfind $(OCAMLC) $(ALL_CFLAGS) $<
+
+.mll.ml:
+	ocamlfind ocamllex $<
+
+.mly.ml:
+	ocamlfind ocamlyacc $<
+
+.PHONY: all bytecode native clean
+
+Makefile: ;
+$(SRC): ;

+ 137 - 137
libs/ttflib/main.ml

@@ -1,137 +1,137 @@
-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;
- 				} 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 ->
-	()
+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;
+ 				} 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 ->
+	()

+ 50 - 50
libs/ttflib/tTFCanvasWriter.ml

@@ -1,50 +1,50 @@
-(*
- * 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
+(*
+ * 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

+ 350 - 350
libs/ttflib/tTFData.ml

@@ -1,350 +1,350 @@
-(*
- * 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_config = {
-	mutable ttfc_range_str : string;
-	mutable ttfc_font_name : string option;
-}
+(*
+ * 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_config = {
+	mutable ttfc_range_str : string;
+	mutable ttfc_font_name : string option;
+}

+ 49 - 49
libs/ttflib/tTFJsonWriter.ml

@@ -1,49 +1,49 @@
-(*
- * 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
+(*
+ * 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

+ 688 - 688
libs/ttflib/tTFParser.ml

@@ -1,688 +1,688 @@
-(*
- * 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 : Pervasives.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;
-	}
+(*
+ * 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 : Pervasives.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;
+	}

+ 210 - 210
libs/ttflib/tTFSwfWriter.ml

@@ -1,210 +1,210 @@
-(*
- * 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);
-	IO.nwrite_string ch f2.font_name;
-	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 = false;
-		font_is_bold = false;
-		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;
-	}
-;;
+(*
+ * 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);
+	IO.nwrite_string ch f2.font_name;
+	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 = false;
+		font_is_bold = false;
+		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;
+	}
+;;

+ 275 - 275
libs/ttflib/tTFTools.ml

@@ -1,275 +1,275 @@
-(*
- * 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
-
-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 = UChar.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
+(*
+ * 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
+
+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 = UChar.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