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