Skip to content

Instantly share code, notes, and snippets.

@slaskis
Created July 2, 2010 08:27
Show Gist options
  • Save slaskis/461102 to your computer and use it in GitHub Desktop.
Save slaskis/461102 to your computer and use it in GitHub Desktop.
diff --git a/swflib/actionScript.ml b/swflib/actionScript.ml
index f8d9f04..05e5dce 100644
--- a/swflib/actionScript.ml
+++ b/swflib/actionScript.ml
@@ -208,7 +208,7 @@ let action_data_length = function
| _ ->
0
-let action_length a =
+let action_length a =
let len = (if action_id a >= 0x80 then 3 else 1) in
len + action_data_length a
@@ -224,7 +224,7 @@ let read_mm_double ch =
let write_mm_double ch f =
let i64 = Int64.bits_of_float f in
write_real_i32 ch (Int64.to_int32 (Int64.shift_right_logical i64 32));
- write_real_i32 ch (Int64.to_int32 i64)
+ write_real_i32 ch (Int64.to_int32 i64)
let read_string_max ch len =
let b = Buffer.create 0 in
@@ -234,7 +234,7 @@ let read_string_max ch len =
String.sub s 0 (String.length s - 1)
end else
let c = read ch in
- if c = '\000' then
+ if c = '\000' then
Buffer.contents b
else begin
Buffer.add_char b c;
@@ -243,7 +243,7 @@ let read_string_max ch len =
in
loop len
-let parse_push_item ch len =
+let parse_push_item ch len =
let id = read_byte ch in
match id with
| 0 -> PString (read_string_max ch len)
@@ -291,8 +291,8 @@ let parse_f2_flags n =
if n land !v <> 0 then flags := f :: !flags;
v := !v lsl 1
in
- List.iter add_flag
- [ThisRegister; ThisNoVar; ArgumentsRegister; ArgumentsNoVar; SuperRegister;
+ List.iter add_flag
+ [ThisRegister; ThisNoVar; ArgumentsRegister; ArgumentsNoVar; SuperRegister;
SuperNoVar; RootRegister; ParentRegister; GlobalRegister];
!flags
@@ -301,7 +301,7 @@ let parse_function_decl2 ch =
let nargs = read_ui16 ch in
let nregs = read_byte ch in
let flags = parse_f2_flags (read_ui16 ch) in
- let rec loop n =
+ let rec loop n =
if n = 0 then
[]
else
@@ -324,11 +324,11 @@ let parse_action ch =
let id = read_byte ch in
let len = (if id >= 0x80 then read_ui16 ch else 0) in
let len = (if len = 0xFFFF then 0 else len) in
- let act =
+ let act =
(match id with
| 0x81 ->
AGotoFrame (read_ui16 ch)
- | 0x83 ->
+ | 0x83 ->
let url = read_string ch in
let target = read_string ch in
AGetURL (url,target)
@@ -395,13 +395,13 @@ let parse_action ch =
let size_to_jump_index acts curindex size =
let delta = ref 0 in
- let size = ref size in
+ let size = ref size in
if !size >= 0 then begin
while !size > 0 do
incr delta;
size := !size - action_length (DynArray.get acts (curindex + !delta));
if !size < 0 then error "Unaligned code";
- done;
+ done;
end else begin
while !size < 0 do
size := !size + action_length (DynArray.get acts (curindex + !delta));
@@ -416,7 +416,7 @@ let parse_actions ch =
let rec loop() =
match parse_action ch with
| AEnd -> ()
- | AUnknown (0xFF,"") ->
+ | AUnknown (0xFF,"") ->
DynArray.add acts APlay;
DynArray.add acts APlay;
DynArray.add acts APlay;
@@ -488,7 +488,7 @@ let write_push_item_data ch = function
let f2_flags_value flags =
let fval = function
| ThisRegister -> 1
- | ThisNoVar -> 2
+ | ThisNoVar -> 2
| ArgumentsRegister -> 4
| ArgumentsNoVar -> 8
| SuperRegister -> 16
@@ -497,7 +497,7 @@ let f2_flags_value flags =
| ParentRegister -> 128
| GlobalRegister -> 256
in
- List.fold_left (fun n f -> n lor (fval f)) 0 flags
+ List.fold_left (fun n f -> n lor (fval f)) 0 flags
let write_action_data acts curindex ch = function
| AGotoFrame frame ->
@@ -533,7 +533,7 @@ let write_action_data acts curindex ch = function
| ATry t ->
let tsize = jump_index_to_size acts curindex t.tr_trylen in
let csize = (match t.tr_catchlen with None -> 0 | Some idx -> jump_index_to_size acts (curindex + t.tr_trylen) idx) in
- let fsize = (match t.tr_finallylen with None -> 0 | Some idx -> jump_index_to_size acts (curindex + t.tr_trylen + (match t.tr_catchlen with None -> 0 | Some n -> n)) idx) in
+ let fsize = (match t.tr_finallylen with None -> 0 | Some idx -> jump_index_to_size acts (curindex + t.tr_trylen + (match t.tr_catchlen with None -> 0 | Some n -> n)) idx) in
let flags = (if t.tr_catchlen <> None then 1 else 0) lor (if t.tr_finallylen <> None then 2 else 0) lor (match t.tr_style with TryRegister _ -> 4 | TryVariable _ -> 0) in
write_byte ch flags;
write_ui16 ch tsize;
@@ -544,7 +544,7 @@ let write_action_data acts curindex ch = function
| TryRegister r -> write_byte ch r)
| AWith target ->
let size = jump_index_to_size acts curindex target in
- write_ui16 ch size
+ write_ui16 ch size
| APush items ->
List.iter (fun item ->
write_byte ch (push_item_id item);
@@ -596,7 +596,7 @@ let action_string get_ident pos = function
| AGotoFrame n -> sprintf "GOTOFRAME %d" n
| AGetURL (a,b) -> sprintf "GETURL '%s' '%s'" a b
| ASetReg n -> sprintf "SETREG %d" n
- | AStringPool strlist ->
+ | AStringPool strlist ->
let b = Buffer.create 0 in
Buffer.add_string b "STRINGS ";
let p = ref 0 in
@@ -628,7 +628,7 @@ let action_string get_ident pos = function
List.iter (fun it ->
Buffer.add_char b ' ';
match it with
- | PString s ->
+ | PString s ->
Buffer.add_char b '"';
Buffer.add_string b s;
Buffer.add_char b '"'
diff --git a/swflib/as3code.ml b/swflib/as3code.ml
index 6fb2e41..ff57291 100644
--- a/swflib/as3code.ml
+++ b/swflib/as3code.ml
@@ -212,7 +212,7 @@ let length = function
| A3Unk _ -> 1
| A3AsType n | A3IsType n ->
1 + int_length (int_index n)
- | A3DebugReg (name,reg,line) -> 1 + 1 + int_length (int_index name) + 1 + int_length line
+ | A3DebugReg (name,reg,line) -> 1 + 1 + int_length (int_index name) + int_length (reg - 1) + int_length line
| A3GetGlobalScope -> 1
| A3GetScope n -> 1 + int_length n
| A3Reg n | A3SetReg n -> if n >= 1 && n <= 3 then 1 else (1 + int_length n)
@@ -421,7 +421,7 @@ let opcode ch =
| 0xEF ->
if IO.read_byte ch <> 1 then assert false;
let name = read_index ch in
- let reg = read_byte ch + 1 in
+ let reg = read_int ch + 1 in
let line = read_int ch in
A3DebugReg (name,reg,line)
| 0xF0 -> A3DebugLine (read_int ch)
@@ -721,7 +721,7 @@ let write ch = function
write_byte ch 0xEF;
write_byte ch 0x01;
write_index ch name;
- write_byte ch (reg - 1);
+ write_int ch (reg - 1);
write_int ch line;
| A3DebugLine f ->
write_byte ch 0xF0;
diff --git a/swflib/as3hl.mli b/swflib/as3hl.mli
index 9a7733e..e469052 100644
--- a/swflib/as3hl.mli
+++ b/swflib/as3hl.mli
@@ -187,7 +187,7 @@ and hl_function = {
hlf_init_scope : int;
hlf_max_scope : int;
mutable hlf_code : hl_opcode array;
- mutable hlf_trys : hl_try_catch array;
+ hlf_trys : hl_try_catch array;
hlf_locals : (hl_name * hl_name option * hl_slot * bool) array; (* bool = const - mostly false *)
}
diff --git a/swflib/png.ml b/swflib/png.ml
index 6769534..3f1188b 100644
--- a/swflib/png.ml
+++ b/swflib/png.ml
@@ -57,7 +57,7 @@ type header = {
type chunk_id = string
-type chunk =
+type chunk =
| CEnd
| CHeader of header
| CData of string
@@ -134,7 +134,7 @@ let color_bits = function
| IBits4 -> 4
| IBits8 -> 8)
-let crc_table = Array.init 256 (fun n ->
+let crc_table = Array.init 256 (fun n ->
let c = ref (Int32.of_int n) in
for k = 0 to 7 do
if Int32.logand !c 1l <> 0l then
@@ -296,7 +296,7 @@ let filter png data =
match head.png_color with
| ClGreyScale _
| ClGreyAlpha _
- | ClIndexed _
+ | ClIndexed _
| ClTrueColor (TBits16,_) -> error Unsupported_colors
| ClTrueColor (TBits8,alpha) ->
let alpha = (match alpha with NoAlpha -> false | HaveAlpha -> true) in
@@ -311,7 +311,7 @@ let filter png data =
let filters = [|
(fun x y v -> v
);
- (fun x y v ->
+ (fun x y v ->
let v2 = if x = 0 then 0 else bget (!bp - 4) in
v + v2
);
diff --git a/swflib/png.mli b/swflib/png.mli
index c8b5a42..3446b2d 100644
--- a/swflib/png.mli
+++ b/swflib/png.mli
@@ -57,7 +57,7 @@ type header = {
type chunk_id = string
-type chunk =
+type chunk =
| CEnd
| CHeader of header
| CData of string
diff --git a/swflib/swf.ml b/swflib/swf.ml
index 7398690..b70fd45 100644
--- a/swflib/swf.ml
+++ b/swflib/swf.ml
@@ -20,8 +20,6 @@ type float16 = int
type unknown = string
-type binary = string
-
type action_count = int
type rgb = {
@@ -43,13 +41,13 @@ type color =
type gradient =
| GradientRGB of ((int * rgb) list * int)
- | GradientRGBA of ((int * rgba) list * int)
+ | GradientRGBA of ((int * rgba) list * int)
type rect = {
rect_nbits : int;
left : int;
right : int;
- top : int;
+ top : int;
bottom : int;
}
@@ -57,7 +55,7 @@ type big_rect = {
brect_nbits : int;
bleft : int list;
bright : int list;
- btop : int list;
+ btop : int list;
bbottom : int list;
}
@@ -263,7 +261,7 @@ type header = {
mutable h_version : int;
mutable h_size : rect;
mutable h_fps : float16;
- mutable h_frame_count : int;
+ mutable h_frame_count : int;
mutable h_compressed : bool;
}
@@ -272,11 +270,6 @@ type export = {
exp_name : string;
}
-type import = {
- mutable imp_id : int;
- imp_name : string;
-}
-
type do_init_action = {
mutable dia_id : int;
dia_actions : actions;
@@ -301,7 +294,7 @@ type sfs_bitmap = {
sfb_mpos : matrix;
}
-type shape_fill_style =
+type shape_fill_style =
| SFSSolid of rgb
| SFSSolid3 of rgba
| SFSLinearGradient of matrix * gradient
@@ -344,7 +337,7 @@ type shape_straight_edge_record = {
sser_line : int option * int option;
}
-type shape_record =
+type shape_record =
| SRStyleChange of shape_change_style_record
| SRCurvedEdge of shape_curved_edge_record
| SRStraightEdge of shape_straight_edge_record
@@ -384,15 +377,14 @@ type filter =
type bitmap_jpg = {
mutable jpg_id : int;
- jpg_data : binary;
+ jpg_data : string;
}
type bitmap_data = {
mutable bd_id : int;
- bd_table : binary option;
- bd_data : binary;
- bd_alpha : binary option;
- bd_deblock : int option;
+ bd_table : string option;
+ bd_data : string;
+ bd_alpha : string option;
}
type bitmap_lossless = {
@@ -410,9 +402,19 @@ type morph_shape = {
msh_data : unknown;
}
-type cid_data = {
- mutable cd_id : int;
- cd_data : binary;
+type font2 = {
+ mutable ft2_id : int;
+ ft2_data : unknown;
+}
+
+type font3 = {
+ mutable ft3_id : int;
+ ft3_data : unknown;
+}
+
+type font_glyphs = {
+ mutable fgl_id : int;
+ fgl_data : unknown;
}
type text_glyph = {
@@ -496,13 +498,10 @@ type f9class = {
f9_classname : string;
}
-type files_attrib = {
- fa_network : bool;
- fa_as3 : bool;
- fa_metadata : bool;
- fa_gpu : bool;
- fa_direct_blt : bool;
-}
+type sandbox =
+ | SBLocal
+ | SBNetwork
+ | SBUnknown of int
type tag_data =
| TEnd
@@ -510,12 +509,10 @@ type tag_data =
| TShape of shape
| TRemoveObject of remove_object
| TBitsJPEG of bitmap_jpg
- | TJPEGTables of binary
+ | TJPEGTables of string
| TSetBgColor of rgb
- | TFont of cid_data
| TText of text
| TDoAction of actions
- | TFontInfo of cid_data
| TSound of sound
| TStartSound of start_sound
| TBitsLossless of bitmap_lossless
@@ -535,33 +532,25 @@ type tag_data =
| TFrameLabel of string * char option
| TSoundStreamHead2 of unknown
| TMorphShape of morph_shape
- | TFont2 of cid_data
+ | TFont2 of font2
| TExport of export list
- | TImport of string * import list
| TDoInitAction of do_init_action
- | TVideoStream of cid_data
- | TVideoFrame of cid_data
- | TFontInfo2 of cid_data
+ | TVideoStream of unknown
+ | TVideoFrame of unknown
| TDebugID of unknown
| TEnableDebugger2 of int * string
| TScriptLimits of int * int
- | TFilesAttributes of files_attrib
+ | TSandbox of sandbox
| TPlaceObject3 of place_object
- | TImport2 of string * import list
- | TFontAlignZones of cid_data
- | TCSMSettings of cid_data
- | TFont3 of cid_data
+ | TFontGlyphs of font_glyphs
+ | TTextInfo of unknown
+ | TFont3 of font3
| TF9Classes of f9class list
| TMetaData of string
- | TScale9 of int * rect
| TActionScript3 of (int * string) option * As3.as3_tag
| TShape4 of shape
- | TMorphShape2 of morph_shape
- | TScenes of (int * string) list * (int * string) list
- | TBinaryData of int * binary
- | TFontName of cid_data
- | TBitsJPEG4 of bitmap_data
- | TFont4 of cid_data
+ | TShape5 of int * string
+ | TF9Scene of string
| TUnknown of int * unknown
and tag = {
diff --git a/swflib/swfParser.ml b/swflib/swfParser.ml
index 73b0e24..ea3963f 100644
--- a/swflib/swfParser.ml
+++ b/swflib/swfParser.ml
@@ -109,8 +109,6 @@ let rgb_length = 3
let rgba_length = 4
-let string_length s = String.length s + 1
-
let color_length = function
| ColorRGB _ -> rgb_length
| ColorRGBA _ -> rgba_length
@@ -146,10 +144,7 @@ let clip_events_length l =
(if !swf_version >= 6 then 10 else 6) + sum clip_event_length l
let export_length e =
- 2 + string_length e.exp_name
-
-let import_length i =
- 2 + string_length i.imp_name
+ 2 + String.length e.exp_name + 1
let sound_length s =
2 + 1 + 4 + String.length s.so_data
@@ -260,8 +255,14 @@ let button2_length b =
1 + sum button_record_length b.bt2_records +
sum button_action_length b.bt2_actions
-let cid_data_length c =
- 2 + String.length c.cd_data
+let font2_length f =
+ 2 + String.length f.ft2_data
+
+let font3_length f =
+ 2 + String.length f.ft3_data
+
+let font_glyphs_length f =
+ 2 + String.length f.fgl_data
let edit_text_layout_length = 9
@@ -274,8 +275,8 @@ let edit_text_length t =
opt_len (const rgba_length) t.edt_color +
opt_len (const 2) t.edt_maxlen +
opt_len (const edit_text_layout_length) t.edt_layout +
- string_length t.edt_variable +
- opt_len string_length t.edt_text
+ String.length t.edt_variable + 1 +
+ opt_len (fun s -> String.length s + 1) t.edt_text
let place_object_length p v3 =
3
@@ -285,7 +286,7 @@ let place_object_length p v3 =
+ opt_len matrix_length p.po_matrix
+ opt_len cxa_length p.po_color
+ opt_len (const 2) p.po_ratio
- + opt_len string_length p.po_inst_name
+ + opt_len (fun s -> String.length s + 1) p.po_inst_name
+ opt_len (const 2) p.po_clip_depth
+ opt_len clip_events_length p.po_events
+ (if v3 then
@@ -310,14 +311,10 @@ let rec tag_data_length = function
String.length tab
| TSetBgColor _ ->
rgb_length
- | TFont c ->
- cid_data_length c
| TText t ->
text_length t
| TDoAction acts ->
actions_length acts
- | TFontInfo c ->
- cid_data_length c
| TSound s ->
sound_length s
| TStartSound s ->
@@ -351,60 +348,49 @@ let rec tag_data_length = function
| TProductInfo s ->
String.length s
| TFrameLabel (label,id) ->
- string_length label + (match id with None -> 0 | Some _ -> 1)
+ String.length label + 1 + (match id with None -> 0 | Some _ -> 1)
| TSoundStreamHead2 data ->
String.length data
- | TMorphShape s | TMorphShape2 s ->
+ | TMorphShape s ->
morph_shape_length s
- | TFont2 c | TFont3 c | TFontAlignZones c ->
- cid_data_length c
+ | TFont2 f ->
+ font2_length f
| TExport el ->
2 + sum export_length el
- | TImport (url,il) ->
- string_length url + 2 + sum import_length il
| TDoInitAction i ->
2 + actions_length i.dia_actions
- | TVideoStream c ->
- cid_data_length c
- | TVideoFrame c ->
- cid_data_length c
- | TFontInfo2 c ->
- cid_data_length c
+ | TVideoStream s ->
+ String.length s
+ | TVideoFrame s ->
+ String.length s
| TDebugID s ->
String.length s
- | TEnableDebugger2 (_,pass) ->
- 2 + string_length pass
+ | TEnableDebugger2 (_,data) ->
+ 2 + String.length data + 1
| TScriptLimits _ ->
4
- | TFilesAttributes _ ->
+ | TSandbox _ ->
4
| TPlaceObject3 p ->
place_object_length p true
- | TImport2 (url,il) ->
- string_length url + 1 + 1 + 2 + sum import_length il
- | TCSMSettings c ->
- cid_data_length c
+ | TFontGlyphs f ->
+ font_glyphs_length f
+ | TTextInfo s ->
+ String.length s
+ | TFont3 f ->
+ font3_length f
| TF9Classes l ->
- 2 + sum (fun c -> string_length c.f9_classname + 2) l
+ 2 + sum (fun c -> String.length c.f9_classname + 1 + 2) l
| TMetaData meta ->
- string_length meta
- | TScale9 (_,r) ->
- 2 + rect_length r
+ String.length meta
| TActionScript3 (id,a) ->
- (match id with None -> 0 | Some (id,f) -> 4 + string_length f) + As3parse.as3_length a
+ (match id with None -> 0 | Some (id,f) -> 4 + String.length f + 1) + As3parse.as3_length a
| TShape4 s ->
shape_length s
- | TScenes (sl,fl) ->
- As3parse.int_length (List.length sl) + sum (fun(n,s) -> As3parse.int_length n + string_length s) sl +
- As3parse.int_length (List.length fl) + sum (fun(n,s) -> As3parse.int_length n + string_length s) fl
- | TBinaryData (_,data) ->
- 2 + String.length data
- | TFontName c ->
- cid_data_length c
- | TBitsJPEG4 b ->
- 2 + 2 + 4 + opt_len String.length b.bd_table + String.length b.bd_data + opt_len String.length b.bd_alpha
- | TFont4 c ->
- cid_data_length c
+ | TShape5 (_,s) ->
+ 2 + String.length s
+ | TF9Scene name ->
+ 2 + String.length name + 1 + 1
| TUnknown (_,data) ->
String.length data
@@ -998,12 +984,28 @@ let parse_edit_text ch =
edt_outlines = (flags land 256) <> 0;
}
-let parse_cid_data ch len =
+let parse_font2 ch len =
let id = read_ui16 ch in
let data = nread ch (len - 2) in
{
- cd_id = id;
- cd_data = data;
+ ft2_id = id;
+ ft2_data = data;
+ }
+
+let parse_font3 ch len =
+ let id = read_ui16 ch in
+ let data = nread ch (len - 2) in
+ {
+ ft3_id = id;
+ ft3_data = data;
+ }
+
+let parse_font_glyphs ch len =
+ let id = read_ui16 ch in
+ let data = nread ch (len - 2) in
+ {
+ fgl_id = id;
+ fgl_data = data;
}
let parse_morph_shape ch len =
@@ -1120,14 +1122,6 @@ let parse_place_object ch v3 =
po_bcache = bcache;
}
-let parse_import ch =
- let cid = read_ui16 ch in
- let name = read_string ch in
- {
- imp_id = cid;
- imp_name = name
- }
-
let rec parse_tag ch h =
let id = h lsr 6 in
let len = h land 63 in
@@ -1146,7 +1140,6 @@ let rec parse_tag ch h =
TShowFrame
| 0x02 when !full_parsing ->
TShape (parse_shape ch len 1)
- (* 0x03 invalid *)
(*//0x04 TPlaceObject *)
| 0x05 ->
let cid = read_ui16 ch in
@@ -1167,14 +1160,12 @@ let rec parse_tag ch h =
TJPEGTables (nread ch len)
| 0x09 ->
TSetBgColor (read_rgb ch)
- | 0x0A ->
- TFont (parse_cid_data ch len)
+ (*//0x0A TFont *)
| 0x0B when !full_parsing ->
TText (parse_text ch false)
| 0x0C ->
TDoAction (parse_actions ch)
- | 0x0D ->
- TFontInfo (parse_cid_data ch len)
+ (*//0x0D TFontInfo *)
| 0x0E ->
let sid = read_ui16 ch in
let flags = read_byte ch in
@@ -1193,7 +1184,6 @@ let rec parse_tag ch h =
sts_id = sid;
sts_data = data;
}
- (* 0x10 invalid *)
(*//0x11 TButtonSound *)
(*//0x12 TSoundStreamHead *)
(*//0x13 TSoundStreamBlock *)
@@ -1208,21 +1198,17 @@ let rec parse_tag ch h =
bd_table = table;
bd_data = data;
bd_alpha = None;
- bd_deblock = None;
}
| 0x16 when !full_parsing ->
TShape2 (parse_shape ch len 2)
(*//0x17 TButtonCXForm *)
| 0x18 ->
TProtect
- (* 0x19 invalid *)
| 0x1A when !full_parsing ->
TPlaceObject2 (parse_place_object ch false)
- (* 0x1B invalid *)
| 0x1C ->
let depth = read_ui16 ch in
TRemoveObject2 depth
- (* 0x1D-1F invalid *)
| 0x20 when !full_parsing ->
TShape3 (parse_shape ch len 3)
| 0x21 when !full_parsing ->
@@ -1240,13 +1226,11 @@ let rec parse_tag ch h =
bd_table = table;
bd_data = data;
bd_alpha = Some alpha;
- bd_deblock = None;
}
| 0x24 ->
TBitsLossless2 (parse_bitmap_lossless ch len)
| 0x25 when !full_parsing ->
TEditText (parse_edit_text ch)
- (* 0x26 invalid *)
| 0x27 ->
let cid = read_ui16 ch in
let fcount = read_ui16 ch in
@@ -1256,24 +1240,18 @@ let rec parse_tag ch h =
c_frame_count = fcount;
c_tags = tags;
}
- (* 0x28 invalid *)
| 0x29 ->
- (* undocumented ? *)
TProductInfo (nread ch len)
- (* 0x2A invalid *)
| 0x2B ->
let label = read_string ch in
let id = (if len = String.length label + 2 then Some (read ch) else None) in
TFrameLabel (label,id)
- (* 0x2C invalid *)
| 0x2D ->
TSoundStreamHead2 (nread ch len)
| 0x2E when !full_parsing ->
TMorphShape (parse_morph_shape ch len)
- (* 0x2F invalid *)
| 0x30 when !full_parsing ->
- TFont2 (parse_cid_data ch len)
- (* 0x31-37 invalid *)
+ TFont2 (parse_font2 ch len)
| 0x38 ->
let read_export() =
let cid = read_ui16 ch in
@@ -1284,9 +1262,7 @@ let rec parse_tag ch h =
}
in
TExport (read_count (read_ui16 ch) read_export ())
- | 0x39 ->
- let url = read_string ch in
- TImport (url, read_count (read_ui16 ch) parse_import ch)
+ (*// 0x39 TImport *)
(*// 0x3A TEnableDebugger *)
| 0x3B ->
let cid = read_ui16 ch in
@@ -1296,13 +1272,11 @@ let rec parse_tag ch h =
dia_actions = actions;
}
| 0x3C ->
- TVideoStream (parse_cid_data ch len)
+ TVideoStream (nread ch len)
| 0x3D ->
- TVideoFrame (parse_cid_data ch len)
- | 0x3E ->
- TFontInfo2 (parse_cid_data ch len)
+ TVideoFrame (nread ch len)
+ (*// 0x3E TFontInfo2 *)
| 0x3F ->
- (* undocumented ? *)
TDebugID (nread ch len)
| 0x40 ->
let tag = read_ui16 ch in
@@ -1314,34 +1288,22 @@ let rec parse_tag ch h =
let script_timeout = read_ui16 ch in
TScriptLimits (recursion_depth, script_timeout)
(*// 0x42 TSetTabIndex *)
- (* 0x43-0x44 invalid *)
| 0x45 ->
- let flags = IO.read_i32 ch in
- let mask = 1 lor 8 lor 16 lor 32 lor 64 in
- if (flags lor mask) <> mask then failwith ("Invalid file attributes " ^ string_of_int flags);
- TFilesAttributes {
- fa_network = (flags land 1) <> 0;
- (* flags 2,4 : reserved *)
- fa_as3 = (flags land 8) <> 0;
- fa_metadata = (flags land 16) <> 0;
- fa_gpu = (flags land 32) <> 0;
- fa_direct_blt = (flags land 64) <> 0;
- }
+ TSandbox (match IO.read_i32 ch with
+ | 0 -> SBLocal
+ | 1 -> SBNetwork
+ | n -> SBUnknown n
+ )
| 0x46 when !full_parsing ->
TPlaceObject3 (parse_place_object ch true)
- | 0x47 ->
- let url = read_string ch in
- if IO.read_byte ch <> 1 then assert false;
- if IO.read_byte ch <> 0 then assert false;
- TImport2 (url, read_count (read_ui16 ch) parse_import ch)
| 0x48 when !full_parsing || !force_as3_parsing ->
TActionScript3 (None , As3parse.parse ch len)
| 0x49 when !full_parsing ->
- TFontAlignZones (parse_cid_data ch len)
+ TFontGlyphs (parse_font_glyphs ch len)
| 0x4A ->
- TCSMSettings (parse_cid_data ch len)
+ TTextInfo (nread ch len)
| 0x4B when !full_parsing ->
- TFont3 (parse_cid_data ch len)
+ TFont3 (parse_font3 ch len)
| 0x4C ->
let i = read_ui16 ch in
let rec loop i =
@@ -1357,12 +1319,7 @@ let rec parse_tag ch h =
in
TF9Classes (loop i)
| 0x4D ->
- TMetaData (read_string ch)
- | 0x4E ->
- let cid = read_ui16 ch in
- let rect = read_rect ch in
- TScale9 (cid,rect)
- (* 0x4F-0x51 invalid *)
+ TMetaData (nread ch len)
| 0x52 when !full_parsing || !force_as3_parsing ->
let id = read_i32 ch in
let frame = read_string ch in
@@ -1371,44 +1328,15 @@ let rec parse_tag ch h =
| 0x53 when !full_parsing ->
TShape4 (parse_shape ch len 4)
| 0x54 when !full_parsing ->
- TMorphShape2 (parse_morph_shape ch len)
- (* 0x55 invalid *)
- | 0x56 ->
- let scenes = read_count (As3parse.read_int ch) (fun() ->
- let offset = As3parse.read_int ch in
- let name = read_string ch in
- (offset, name)
- ) () in
- let frames = read_count (As3parse.read_int ch) (fun() ->
- let f = As3parse.read_int ch in
- let name = read_string ch in
- (f, name)
- ) () in
- TScenes (scenes,frames)
- | 0x57 ->
- let cid = read_ui16 ch in
- if read_i32 ch <> 0 then assert false;
- let data = nread ch (len - 6) in
- TBinaryData (cid,data)
- | 0x58 ->
- TFontName (parse_cid_data ch len)
- (* // 0x59 TStartSound2 *)
- | 0x5A ->
let id = read_ui16 ch in
- let size = read_i32 ch in
- let deblock = read_ui16 ch in
- let data = nread ch size in
- let data, table = extract_jpg_table data in
- let alpha = nread ch (len - 6 - size) in
- TBitsJPEG4 {
- bd_id = id;
- bd_table = table;
- bd_data = data;
- bd_alpha = Some alpha;
- bd_deblock = Some deblock;
- }
- | 0x5B ->
- TFont4 (parse_cid_data ch len)
+ TShape5 (id,nread ch (len - 2))
+ | 0x56 ->
+ let n = read_ui16 ch in
+ if n <> 1 then assert false;
+ let name = read_string ch in
+ let k = read_byte ch in
+ if k <> 0 then assert false;
+ TF9Scene name
| _ ->
(*if !Swf.warnings then Printf.printf "Unknown tag 0x%.2X\n" id;*)
TUnknown (id,nread ch len)
@@ -1462,10 +1390,8 @@ let rec tag_id = function
| TBitsJPEG _ -> 0x06
| TJPEGTables _ -> 0x08
| TSetBgColor _ -> 0x09
- | TFont _ -> 0x0A
| TText _ -> 0x0B
| TDoAction _ -> 0x0C
- | TFontInfo _ -> 0x0D
| TSound _ -> 0x0E
| TStartSound _ -> 0x0F
| TBitsLossless _ -> 0x14
@@ -1487,32 +1413,24 @@ let rec tag_id = function
| TMorphShape _ -> 0x2E
| TFont2 _ -> 0x30
| TExport _ -> 0x38
- | TImport _ -> 0x39
| TDoInitAction _ -> 0x3B
| TVideoStream _ -> 0x3C
| TVideoFrame _ -> 0x3D
- | TFontInfo2 _ -> 0x3E
| TDebugID _ -> 0x3F
| TEnableDebugger2 _ -> 0x40
| TScriptLimits _ -> 0x41
- | TFilesAttributes _ -> 0x45
+ | TSandbox _ -> 0x45
| TPlaceObject3 _ -> 0x46
- | TImport2 _ -> 0x47
- | TFontAlignZones _ -> 0x49
- | TCSMSettings _ -> 0x4A
+ | TFontGlyphs _ -> 0x49
+ | TTextInfo _ -> 0x4A
| TFont3 _ -> 0x4B
| TF9Classes _ -> 0x4C
| TMetaData _ -> 0x4D
- | TScale9 _ -> 0x4E
| TActionScript3 (None,_) -> 0x48
| TActionScript3 _ -> 0x52
| TShape4 _ -> 0x53
- | TMorphShape2 _ -> 0x54
- | TScenes _ -> 0x56
- | TBinaryData _ -> 0x57
- | TFontName _ -> 0x58
- | TBitsJPEG4 _ -> 0x5A
- | TFont4 _ -> 0x5B
+ | TShape5 _ -> 0x54
+ | TF9Scene _ -> 0x56
| TUnknown (id,_) -> id
let write_clip_event ch c =
@@ -1707,9 +1625,17 @@ let write_edit_text ch t =
write_string ch t.edt_variable;
opt (write_string ch) t.edt_text
-let write_cid_data ch c =
- write_ui16 ch c.cd_id;
- nwrite ch c.cd_data
+let write_font2 ch t =
+ write_ui16 ch t.ft2_id;
+ nwrite ch t.ft2_data
+
+let write_font3 ch t =
+ write_ui16 ch t.ft3_id;
+ nwrite ch t.ft3_data
+
+let write_font_glyphs ch t =
+ write_ui16 ch t.fgl_id;
+ nwrite ch t.fgl_data
let write_filter_gradient ch fg =
write_byte ch (List.length fg.fgr_colors);
@@ -1821,14 +1747,10 @@ let rec write_tag_data ch = function
nwrite ch tab
| TSetBgColor c ->
write_rgb ch c
- | TFont c ->
- write_cid_data ch c
| TText t ->
write_text ch t
| TDoAction acts ->
write_actions ch acts
- | TFontInfo c ->
- write_cid_data ch c
| TSound s ->
write_ui16 ch s.so_id;
write_byte ch s.so_flags;
@@ -1881,30 +1803,21 @@ let rec write_tag_data ch = function
nwrite ch data
| TMorphShape s ->
write_morph_shape ch s
- | TFont2 c ->
- write_cid_data ch c
+ | TFont2 f ->
+ write_font2 ch f
| TExport el ->
write_ui16 ch (List.length el);
List.iter (fun e ->
write_ui16 ch e.exp_id;
write_string ch e.exp_name
) el
- | TImport (url,il) ->
- write_string ch url;
- write_ui16 ch (List.length il);
- List.iter (fun i ->
- write_ui16 ch i.imp_id;
- write_string ch i.imp_name
- ) il
| TDoInitAction i ->
write_ui16 ch i.dia_id;
write_actions ch i.dia_actions;
- | TVideoStream c ->
- write_cid_data ch c
- | TVideoFrame c ->
- write_cid_data ch c
- | TFontInfo2 c ->
- write_cid_data ch c
+ | TVideoStream s ->
+ nwrite ch s
+ | TVideoFrame s ->
+ nwrite ch s
| TDebugID s ->
nwrite ch s
| TEnableDebugger2 (tag,pass) ->
@@ -1913,26 +1826,19 @@ let rec write_tag_data ch = function
| TScriptLimits (recursion_depth, script_timeout) ->
write_ui16 ch recursion_depth;
write_ui16 ch script_timeout;
- | TFilesAttributes f ->
- let flags = make_flags [f.fa_network;false;false;f.fa_as3;f.fa_metadata;f.fa_gpu;f.fa_direct_blt] in
- write_i32 ch flags
+ | TSandbox s ->
+ write_i32 ch (match s with
+ | SBLocal -> 0
+ | SBNetwork -> 1
+ | SBUnknown n -> n)
| TPlaceObject3 p ->
write_place_object ch p true;
- | TImport2 (url,il) ->
- write_string ch url;
- write_byte ch 1;
- write_byte ch 0;
- write_ui16 ch (List.length il);
- List.iter (fun i ->
- write_ui16 ch i.imp_id;
- write_string ch i.imp_name
- ) il
- | TFontAlignZones c ->
- write_cid_data ch c
- | TCSMSettings c ->
- write_cid_data ch c
- | TFont3 c ->
- write_cid_data ch c
+ | TFontGlyphs f ->
+ write_font_glyphs ch f
+ | TTextInfo s ->
+ nwrite ch s
+ | TFont3 f ->
+ write_font3 ch f
| TF9Classes l ->
write_ui16 ch (List.length l);
List.iter (fun c ->
@@ -1940,10 +1846,7 @@ let rec write_tag_data ch = function
write_string ch c.f9_classname
) l
| TMetaData meta ->
- write_string ch meta
- | TScale9 (cid,r) ->
- write_ui16 ch cid;
- write_rect ch r;
+ nwrite ch meta
| TActionScript3 (id,a) ->
(match id with
| None -> ()
@@ -1954,33 +1857,13 @@ let rec write_tag_data ch = function
As3parse.write ch a
| TShape4 s ->
write_shape ch s
- | TMorphShape2 m ->
- write_morph_shape ch m
- | TScenes (sl,fl) ->
- As3parse.write_int ch (List.length sl);
- List.iter (fun (n,s) ->
- As3parse.write_int ch n;
- write_string ch s;
- ) sl;
- As3parse.write_int ch (List.length fl);
- List.iter (fun (n,s) ->
- As3parse.write_int ch n;
- write_string ch s;
- ) sl;
- | TBinaryData (id,data) ->
+ | TShape5 (id,s) ->
write_ui16 ch id;
- nwrite ch data
- | TFontName c ->
- write_cid_data ch c
- | TBitsJPEG4 b ->
- write_ui16 ch b.bd_id;
- write_i32 ch (String.length b.bd_data + opt_len String.length b.bd_table);
- opt (write_ui16 ch) b.bd_deblock;
- opt (nwrite ch) b.bd_table;
- nwrite ch b.bd_data;
- opt (nwrite ch) b.bd_alpha;
- | TFont4 c ->
- write_cid_data ch c
+ nwrite ch s
+ | TF9Scene s ->
+ write_ui16 ch 1;
+ write_string ch s;
+ write_byte ch 0;
| TUnknown (_,data) ->
nwrite ch data
@@ -2015,175 +1898,6 @@ let write ch (h,tags) =
write_tag ch tag_end;
if h.h_compressed then IO.close_out ch
-(* ************************************************************************ *)
-(* EXTRA *)
-
-let scan fid f t =
- match t.tdata with
- | TEnd
- | TShowFrame
- | TJPEGTables _
- | TSetBgColor _
- | TDoAction _
- | TActionScript3 _
- | TProtect
- | TRemoveObject2 _
- | TFrameLabel _
- | TSoundStreamHead2 _
- | TScenes _
- | TEnableDebugger2 _
- | TMetaData _
- | TScriptLimits _
- | TDebugID _
- | TFilesAttributes _
- | TProductInfo _
- -> ()
- | TF9Classes l ->
- List.iter (fun c ->
- match c.f9_cid with
- | None -> ()
- | Some id -> c.f9_cid <- Some (f id)
- ) l
- | TShape s
- | TShape2 s
- | TShape3 s
- | TShape4 s ->
- s.sh_id <- fid s.sh_id;
- let loop fs =
- List.iter (fun s -> match s with
- | SFSBitmap b ->
- if b.sfb_cid <> 0xFFFF then b.sfb_cid <- f b.sfb_cid;
- | _ ->
- ()
- ) fs
- in
- loop s.sh_style.sws_fill_styles;
- List.iter (fun s -> match s with
- | SRStyleChange { scsr_new_styles = Some s } ->
- loop s.sns_fill_styles
- | _ ->
- ()
- ) s.sh_style.sws_records.srs_records;
- | TRemoveObject r ->
- r.rmo_id <- f r.rmo_id
- | TBitsJPEG b ->
- b.jpg_id <- fid b.jpg_id
- | TBitsJPEG2 b ->
- b.bd_id <- fid b.bd_id
- | TText t
- | TText2 t ->
- t.txt_id <- fid t.txt_id;
- List.iter (fun r -> match r.txr_font with None -> () | Some (id,id2) -> r.txr_font <- Some (f id,id2)) t.txt_records
- | TEditText t ->
- t.edt_id <- fid t.edt_id;
- (match t.edt_font with None -> () | Some (id,h) -> t.edt_font <- Some (f id,h))
- | TSound s ->
- s.so_id <- fid s.so_id
- | TStartSound s ->
- s.sts_id <- f s.sts_id
- | TBitsLossless b
- | TBitsLossless2 b ->
- b.bll_id <- fid b.bll_id
- | TPlaceObject2 p ->
- p.po_cid <- (match p.po_cid with None -> None | Some id -> Some (f id))
- | TButton2 b ->
- b.bt2_id <- fid b.bt2_id;
- List.iter (fun r ->
- r.btr_cid <- f r.btr_cid
- ) b.bt2_records;
- | TBitsJPEG3 j ->
- j.bd_id <- fid j.bd_id
- | TClip c ->
- c.c_id <- fid c.c_id
- | TMorphShape s | TMorphShape2 s ->
- s.msh_id <- fid s.msh_id
- | TFont c | TFont2 c | TFont3 c | TFont4 c ->
- c.cd_id <- fid c.cd_id
- | TExport el ->
- List.iter (fun e -> e.exp_id <- f e.exp_id) el
- | TImport (_,il) | TImport2 (_,il) ->
- List.iter (fun i -> i.imp_id <- fid i.imp_id) il
- | TDoInitAction a ->
- a.dia_id <- f a.dia_id
- | TVideoStream c ->
- c.cd_id <- fid c.cd_id
- | TVideoFrame c ->
- c.cd_id <- f c.cd_id
- | TPlaceObject3 p ->
- p.po_cid <- (match p.po_cid with None -> None | Some id -> Some (f id))
- | TCSMSettings c ->
- c.cd_id <- f c.cd_id
- | TBinaryData (id,data) ->
- t.tdata <- TBinaryData (fid id,data)
- | TFontAlignZones c | TFontInfo c | TFontInfo2 c | TFontName c ->
- c.cd_id <- f c.cd_id
- | TScale9 (id,r) ->
- t.tdata <- TScale9 (f id,r)
- | TBitsJPEG4 j ->
- j.bd_id <- fid j.bd_id
- | TUnknown _ ->
- ()
-
-let tag_name = function
- | TEnd -> "End"
- | TShowFrame -> "ShowFrame"
- | TShape _ -> "Shape"
- | TRemoveObject _ -> "RemoveObject"
- | TBitsJPEG _ -> "BitsJPEG"
- | TJPEGTables _ -> "JPGETables"
- | TSetBgColor _ -> "SetBgColor"
- | TFont _ -> "Font"
- | TText _ -> "Text"
- | TDoAction _ -> "DoAction"
- | TFontInfo _ -> "FontInfo"
- | TSound _ -> "Sound"
- | TStartSound _ -> "StartSound"
- | TBitsLossless _ -> "BitsLossless"
- | TBitsJPEG2 _ -> "BitsJPEG2"
- | TShape2 _ -> "Shape2"
- | TProtect -> "Protect"
- | TPlaceObject2 _ -> "PlaceObject2"
- | TRemoveObject2 _ -> "RemoveObject2"
- | TShape3 _ -> "Shape3"
- | TText2 _ -> "Text2"
- | TButton2 _ -> "Button2"
- | TBitsJPEG3 _ -> "BitsJPEG3"
- | TBitsLossless2 _ -> "Lossless2"
- | TEditText _ -> "EditText"
- | TClip _ -> "Clip"
- | TProductInfo _ -> "ProductInfo"
- | TFrameLabel _ -> "FrameLabel"
- | TSoundStreamHead2 _ -> "SoundStreamHead2"
- | TMorphShape _ -> "MorphShape"
- | TFont2 _ -> "Font2"
- | TExport _ -> "Export"
- | TImport _ -> "Import"
- | TDoInitAction _ -> "DoInitAction"
- | TVideoStream _ -> "VideoStream"
- | TVideoFrame _ -> "VideoFrame"
- | TFontInfo2 _ -> "FontInfo2"
- | TDebugID _ -> "DebugID"
- | TEnableDebugger2 _ -> "EnableDebugger2"
- | TScriptLimits _ -> "ScriptLimits"
- | TFilesAttributes _ -> "FilesAttributes"
- | TPlaceObject3 _ -> "PlaceObject3"
- | TImport2 _ -> "Import2"
- | TFontAlignZones _ -> "FontAlignZones"
- | TCSMSettings _ -> "TCSMSettings"
- | TFont3 _ -> "Font3"
- | TF9Classes _ -> "F9Classes"
- | TMetaData _ -> "MetaData"
- | TScale9 _ -> "Scale9"
- | TActionScript3 _ -> "ActionScript3"
- | TShape4 _ -> "Shape4"
- | TMorphShape2 _ -> "MorphShape2"
- | TScenes _ -> "Scenes"
- | TBinaryData _ -> "BinaryData"
- | TFontName _ -> "FontName"
- | TBitsJPEG4 _ -> "BitsJPEG4"
- | TFont4 _ -> "Font4"
- | TUnknown (n,_) -> Printf.sprintf "Unknown 0x%.2X" n
-
let init inflate deflate =
Swf.__parser := parse;
Swf.__printer := write;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment