|
|
@@ -23,16 +23,6 @@ open Genswf9
|
|
|
open Type
|
|
|
open Common
|
|
|
|
|
|
-type context = {
|
|
|
- mutable f8clips : string list;
|
|
|
- mutable f9clips : f9class list;
|
|
|
- mutable code : tag_data list;
|
|
|
- mutable as3code : As3hl.hl_tag;
|
|
|
- mutable hx9code : (module_type * As3hl.hl_method * As3hl.hl_field) list;
|
|
|
- mutable genmethod : unit -> As3hl.hl_method;
|
|
|
- mutable swc_catalog : string;
|
|
|
-}
|
|
|
-
|
|
|
(* --- MINI ZIP IMPLEMENTATION --- *)
|
|
|
|
|
|
|
|
|
@@ -176,117 +166,6 @@ let convert_header com (w,h,fps,bg) =
|
|
|
let default_header com =
|
|
|
convert_header com (400,300,30.,0xFFFFFF)
|
|
|
|
|
|
-let getclass i =
|
|
|
- if Array.length i.hls_fields <> 1 then
|
|
|
- None
|
|
|
- else match i.hls_fields.(0).hlf_kind with
|
|
|
- | HFClass { hlc_name = HMPath (pack,name) } -> Some (pack,name)
|
|
|
- | _ ->
|
|
|
- None
|
|
|
-
|
|
|
-let build_movieclip ctx (pack,name) =
|
|
|
- let name = HMPath (pack,name) in
|
|
|
- let mc = HMPath (["flash";"display"],"MovieClip") in
|
|
|
- let c = {
|
|
|
- hlc_index = 0;
|
|
|
- hlc_name = name;
|
|
|
- hlc_super = Some mc;
|
|
|
- hlc_sealed = false;
|
|
|
- hlc_final = false;
|
|
|
- hlc_interface = false;
|
|
|
- hlc_namespace = None;
|
|
|
- hlc_implements = [||];
|
|
|
- hlc_construct = ctx.genmethod();
|
|
|
- hlc_fields = [||];
|
|
|
- hlc_static_construct = ctx.genmethod();
|
|
|
- hlc_static_fields = [||];
|
|
|
- } in
|
|
|
- let init = ctx.genmethod() in
|
|
|
- {
|
|
|
- hls_method = { init with
|
|
|
- hlmt_function = match init.hlmt_function with
|
|
|
- | None -> assert false
|
|
|
- | Some f -> Some { f with
|
|
|
- hlf_stack_size = 2;
|
|
|
- hlf_max_scope = 3;
|
|
|
- hlf_code = [|
|
|
|
- HThis;
|
|
|
- HScope;
|
|
|
- HGetGlobalScope;
|
|
|
- HGetLex mc;
|
|
|
- HScope;
|
|
|
- HGetLex mc;
|
|
|
- HClassDef c;
|
|
|
- HPopScope;
|
|
|
- HInitProp name;
|
|
|
- HRetVoid;
|
|
|
- |];
|
|
|
- }
|
|
|
- };
|
|
|
- hls_fields = [|{ hlf_name = c.hlc_name; hlf_slot = 1; hlf_kind = HFClass c; hlf_metas = None }|];
|
|
|
- }
|
|
|
-
|
|
|
-let movieclip_exists types inits path =
|
|
|
- let name = Ast.s_type_path path in
|
|
|
- let rec loop i n =
|
|
|
- if n < 0 then false else
|
|
|
- match i.hls_fields.(n).hlf_kind with
|
|
|
- | HFClass { hlc_name = HMPath (p,n) } when (p,n) = path -> true
|
|
|
- | _ -> loop i (n - 1)
|
|
|
- in
|
|
|
- List.exists (function
|
|
|
- | TClassDecl c when c.cl_path = path ->
|
|
|
- let rec check_super c =
|
|
|
- match c.cl_super with
|
|
|
- | Some ({ cl_path = "flash" :: _ ,_ },_) -> ()
|
|
|
- | Some (c,_) -> check_super c
|
|
|
- | _ -> failwith ("The class " ^ name ^ " must extends a flash.* class")
|
|
|
- in
|
|
|
- check_super c;
|
|
|
- not c.cl_extern
|
|
|
- | TEnumDecl e when e.e_path = path -> failwith ("The clip " ^ name ^ " must be bound to a class")
|
|
|
- | TTypeDecl t when t.t_path = path -> failwith ("The clip " ^ name ^ " must be bound to a class")
|
|
|
- | _ -> false
|
|
|
- ) types || List.exists (fun i -> loop i (Array.length i.hls_fields - 1)) inits
|
|
|
-
|
|
|
-let add_as3_code ctx data types =
|
|
|
- (* set all protected+private fields to public - this will enable overriding/reflection in haXe classes *)
|
|
|
- let ipublic = ref (-1) in
|
|
|
- let ns = Array.mapi (fun i ns ->
|
|
|
- match ns with
|
|
|
- | A3NPrivate _
|
|
|
- | A3NInternal _
|
|
|
- | A3NProtected _
|
|
|
- | A3NPublic None
|
|
|
- ->
|
|
|
- ipublic := i;
|
|
|
- A3NPublic None
|
|
|
- | A3NPublic _
|
|
|
- | A3NNamespace _
|
|
|
- | A3NExplicit _
|
|
|
- | A3NStaticProtected _ -> ns
|
|
|
- ) data.as3_namespaces in
|
|
|
- let cl = Array.map (fun c ->
|
|
|
- { c with cl3_namespace = None }
|
|
|
- ) data.as3_classes in
|
|
|
- let data = { data with as3_namespaces = ns; as3_classes = cl } in
|
|
|
- (* only keep classes that are not redefined in HX code *)
|
|
|
- let inits = As3hlparse.parse data in
|
|
|
- let inits = List.filter (fun i ->
|
|
|
- match getclass i with
|
|
|
- | None -> true
|
|
|
- | Some path ->
|
|
|
- not (List.exists (function
|
|
|
- | TClassDecl c -> c.cl_path = path && not c.cl_extern
|
|
|
- | TEnumDecl e -> e.e_path = path && not e.e_extern
|
|
|
- | TTypeDecl _ -> false
|
|
|
- ) types)
|
|
|
- ) inits in
|
|
|
- ctx.as3code <- ctx.as3code @ inits
|
|
|
-
|
|
|
-let add_as3_clips ctx cl =
|
|
|
- ctx.f9clips <- List.filter (fun c -> c.f9_cid <> None) cl @ ctx.f9clips
|
|
|
-
|
|
|
type dependency_kind =
|
|
|
| DKInherit
|
|
|
| DKExpr
|
|
|
@@ -432,179 +311,210 @@ let build_swc_catalog com types =
|
|
|
] in
|
|
|
"<?xml version=\"1.0\" encoding =\"utf-8\"?>\n" ^ Xml.to_string_fmt x
|
|
|
|
|
|
-let generate com swf_header swf_lib =
|
|
|
- let isf9 = com.flash_version >= 9 in
|
|
|
- let t = Common.timer "generate swf" in
|
|
|
- let file , codeclip = (try let f , c = ExtString.String.split com.file "@" in f, Some c with _ -> com.file , None) in
|
|
|
- let ctx = {
|
|
|
- f8clips = [];
|
|
|
- f9clips = [];
|
|
|
- as3code = [];
|
|
|
- hx9code = [];
|
|
|
- code = [];
|
|
|
- genmethod = (fun() -> assert false);
|
|
|
- swc_catalog = "";
|
|
|
- } in
|
|
|
- if isf9 then begin
|
|
|
- let code, m = Genswf9.generate com in
|
|
|
- ctx.f9clips <- [{ f9_cid = None; f9_classname = "flash.Boot" }];
|
|
|
- ctx.hx9code <- code;
|
|
|
- ctx.genmethod <- m;
|
|
|
- end else begin
|
|
|
- let code, clips = Genswf8.generate com in
|
|
|
- ctx.code <- code;
|
|
|
- ctx.f8clips <- List.map Ast.s_type_path clips;
|
|
|
- end;
|
|
|
- let build_swf content =
|
|
|
- let sandbox = (if com.flash_version >= 8 then
|
|
|
- let net = Common.defined com "network-sandbox" in
|
|
|
- [tag (TFilesAttributes {
|
|
|
- fa_network = net;
|
|
|
- fa_as3 = isf9;
|
|
|
- fa_metadata = false;
|
|
|
- fa_gpu = false;
|
|
|
- fa_direct_blt = false;
|
|
|
- })]
|
|
|
- else
|
|
|
- []
|
|
|
- ) in
|
|
|
- let debug = (if isf9 && Common.defined com "fdb" then [tag (TEnableDebugger2 (0,""))] else []) in
|
|
|
- let base_id = ref 0x5000 in
|
|
|
- let clips = List.fold_left (fun acc m ->
|
|
|
- incr base_id;
|
|
|
- tag ~ext:true (TClip { c_id = !base_id; c_frame_count = 1; c_tags = [] }) ::
|
|
|
- tag ~ext:true (TExport [{ exp_id = !base_id; exp_name = m }]) ::
|
|
|
+let make_as3_public data =
|
|
|
+ (* set all protected+private fields to public - this will enable overriding/reflection in haXe classes *)
|
|
|
+ let ipublic = ref (-1) in
|
|
|
+ let ns = Array.mapi (fun i ns ->
|
|
|
+ match ns with
|
|
|
+ | A3NPrivate _
|
|
|
+ | A3NInternal _
|
|
|
+ | A3NProtected _
|
|
|
+ | A3NPublic None
|
|
|
+ ->
|
|
|
+ ipublic := i;
|
|
|
+ A3NPublic None
|
|
|
+ | A3NPublic _
|
|
|
+ | A3NNamespace _
|
|
|
+ | A3NExplicit _
|
|
|
+ | A3NStaticProtected _ -> ns
|
|
|
+ ) data.as3_namespaces in
|
|
|
+ let cl = Array.map (fun c -> { c with cl3_namespace = None }) data.as3_classes in
|
|
|
+ { data with as3_namespaces = ns; as3_classes = cl }
|
|
|
+
|
|
|
+let build_swf8 com codeclip exports =
|
|
|
+ let code, clips = Genswf8.generate com in
|
|
|
+ let cid = ref 0 in
|
|
|
+ let clips = List.fold_left (fun acc m ->
|
|
|
+ let ename = Ast.s_type_path m in
|
|
|
+ if Hashtbl.mem exports ename then
|
|
|
acc
|
|
|
- ) [] ctx.f8clips in
|
|
|
- let code = (match codeclip with
|
|
|
- | None -> List.map tag ctx.code
|
|
|
- | Some link ->
|
|
|
- incr base_id;
|
|
|
- [
|
|
|
- tag (TClip {
|
|
|
- c_id = !base_id;
|
|
|
- c_frame_count = 1;
|
|
|
- c_tags = List.map tag ctx.code @ [tag TShowFrame];
|
|
|
- });
|
|
|
- tag (TExport [{ exp_id = !base_id; exp_name = link }]);
|
|
|
- ]
|
|
|
- ) in
|
|
|
- List.iter (fun c ->
|
|
|
- let path = ExtString.String.nsplit c.f9_classname "." in
|
|
|
- let path = (match List.rev path with [] -> assert false | x :: l -> List.rev l, x) in
|
|
|
- if c.f9_cid <> None && not (movieclip_exists com.types ctx.as3code path) then
|
|
|
- ctx.as3code <- build_movieclip ctx path :: ctx.as3code;
|
|
|
- ) ctx.f9clips;
|
|
|
- let code9 = if not isf9 then [] else if Common.defined com "swc" then begin
|
|
|
- ctx.swc_catalog <- build_swc_catalog com (List.map (fun (t,_,_) -> t) ctx.hx9code);
|
|
|
- List.map (fun (t,m,f) ->
|
|
|
- let path = (match t_path t with
|
|
|
- | [], name -> name
|
|
|
- | path, name -> String.concat "/" path ^ "/" ^ name
|
|
|
- ) in
|
|
|
- let init = {
|
|
|
- hls_method = m;
|
|
|
- hls_fields = [|f|];
|
|
|
- } in
|
|
|
- tag (TActionScript3 (Some (1,path),As3hlparse.flatten [init]))
|
|
|
- ) ctx.hx9code
|
|
|
- end else begin
|
|
|
- let inits = List.map (fun (_,m,f) ->
|
|
|
- {
|
|
|
- hls_method = m;
|
|
|
- hls_fields = [|f|];
|
|
|
- }
|
|
|
- ) ctx.hx9code in
|
|
|
- [tag (TActionScript3 (None,As3hlparse.flatten (ctx.as3code @ inits)))]
|
|
|
- end in
|
|
|
- let clips9 = (if isf9 then [tag (TF9Classes ctx.f9clips)] else []) in
|
|
|
- sandbox @ debug @ content @ clips @ code @ code9 @ clips9
|
|
|
- in
|
|
|
- let swf = (match swf_lib with
|
|
|
- | None ->
|
|
|
- let header , bg = (match swf_header with None -> default_header com | Some h -> convert_header com h) in
|
|
|
- let tagbg = tag (TSetBgColor { cr = bg lsr 16; cg = (bg lsr 8) land 0xFF; cb = bg land 0xFF }) in
|
|
|
- let tagshow = tag TShowFrame in
|
|
|
- (header,build_swf [tagbg] @ [tagshow])
|
|
|
- | Some file ->
|
|
|
- let file = (try Common.find_file com file with Not_found -> failwith ("File not found : " ^ file)) in
|
|
|
- let ch = IO.input_channel (open_in_bin file) in
|
|
|
- let h, swf = (try Swf.parse ch with _ -> failwith ("The input swf " ^ file ^ " is corrupted")) in
|
|
|
- let header , tagbg = (match swf_header with
|
|
|
- | None ->
|
|
|
- { h with h_version = com.flash_version }, None
|
|
|
- | Some h ->
|
|
|
- let h , bg = convert_header com h in
|
|
|
- let tagbg = tag (TSetBgColor { cr = bg lsr 16; cg = (bg lsr 8) land 0xFF; cb = bg land 0xFF }) in
|
|
|
- h , Some tagbg
|
|
|
+ else begin
|
|
|
+ incr cid;
|
|
|
+ tag ~ext:true (TClip { c_id = !cid; c_frame_count = 1; c_tags = [] }) ::
|
|
|
+ tag ~ext:true (TExport [{ exp_id = !cid; exp_name = ename }]) ::
|
|
|
+ acc
|
|
|
+ end;
|
|
|
+ ) [] clips in
|
|
|
+ let code = (match codeclip with
|
|
|
+ | None -> List.map tag code
|
|
|
+ | Some link ->
|
|
|
+ incr cid;
|
|
|
+ [
|
|
|
+ tag (TClip {
|
|
|
+ c_id = !cid;
|
|
|
+ c_frame_count = 1;
|
|
|
+ c_tags = List.map tag code @ [tag TShowFrame];
|
|
|
+ });
|
|
|
+ tag (TExport [{ exp_id = !cid; exp_name = link }]);
|
|
|
+ ]
|
|
|
+ ) in
|
|
|
+ clips @ code
|
|
|
+
|
|
|
+let build_swf9 com swc =
|
|
|
+ let code, genmethod = Genswf9.generate com in
|
|
|
+ let code = (match swc with
|
|
|
+ | Some cat ->
|
|
|
+ cat := build_swc_catalog com (List.map (fun (t,_,_) -> t) code);
|
|
|
+ List.map (fun (t,m,f) ->
|
|
|
+ let path = (match t_path t with
|
|
|
+ | [], name -> name
|
|
|
+ | path, name -> String.concat "/" path ^ "/" ^ name
|
|
|
) in
|
|
|
- IO.close_in ch;
|
|
|
- let rec loop acc = function
|
|
|
- | [] ->
|
|
|
- failwith ("Frame 1 not found in " ^ file)
|
|
|
- | t :: l ->
|
|
|
- match t.tdata with
|
|
|
- | TUnknown (0x1A,_) (*// PlaceObject2 *)
|
|
|
- | TUnknown (0x46,_) (*// PlaceObject3 *)
|
|
|
- | TPlaceObject2 _
|
|
|
- | TPlaceObject3 _
|
|
|
- | TRemoveObject2 _
|
|
|
- | TRemoveObject _ when not (Common.defined com "flash_use_stage") ->
|
|
|
- loop acc l
|
|
|
- | TSetBgColor _ ->
|
|
|
- (match tagbg with
|
|
|
- | None -> loop (t :: acc) l
|
|
|
- | Some bg -> loop (bg :: acc) l)
|
|
|
- | TShowFrame ->
|
|
|
- build_swf (List.rev acc) @ t :: l
|
|
|
- | TExport el ->
|
|
|
- if isf9 then begin
|
|
|
- List.iter (fun e ->
|
|
|
- ctx.f9clips <- { f9_cid = Some e.exp_id; f9_classname = e.exp_name } :: ctx.f9clips
|
|
|
- ) el;
|
|
|
- loop acc l
|
|
|
- end else begin
|
|
|
- List.iter (fun e ->
|
|
|
- ctx.f8clips <- List.filter (fun x -> x <> e.exp_name) ctx.f8clips
|
|
|
- ) el;
|
|
|
- loop (t :: acc) l
|
|
|
- end;
|
|
|
- | TF9Scene _
|
|
|
- | TEnableDebugger2 _
|
|
|
- | TFilesAttributes _ ->
|
|
|
- loop acc l
|
|
|
- | TF9Classes cl ->
|
|
|
- if isf9 then add_as3_clips ctx cl;
|
|
|
- loop acc l
|
|
|
- | TActionScript3 (_,data) ->
|
|
|
- if isf9 then add_as3_code ctx data com.types;
|
|
|
- loop acc l
|
|
|
- | _ ->
|
|
|
- loop (t :: acc) l
|
|
|
- in
|
|
|
- (header , loop [] swf)
|
|
|
+ let init = {
|
|
|
+ hls_method = m;
|
|
|
+ hls_fields = [|f|];
|
|
|
+ } in
|
|
|
+ tag (TActionScript3 (Some (1,path),As3hlparse.flatten [init]))
|
|
|
+ ) code
|
|
|
+ | None ->
|
|
|
+ let inits = List.map (fun (_,m,f) ->
|
|
|
+ {
|
|
|
+ hls_method = m;
|
|
|
+ hls_fields = [|f|];
|
|
|
+ }
|
|
|
+ ) code in
|
|
|
+ [tag (TActionScript3 (None,As3hlparse.flatten inits))]
|
|
|
+ ) in
|
|
|
+ let clips = [tag (TF9Classes [{ f9_cid = None; f9_classname = "flash.Boot" }])] in
|
|
|
+ code @ clips
|
|
|
+
|
|
|
+let merge com priority (h1,tags1) (h2,tags2) =
|
|
|
+ (* prioritize header+bgcolor for first swf *)
|
|
|
+ let header = if priority then { h2 with h_version = max h2.h_version com.flash_version } else h1 in
|
|
|
+ let tags1 = if priority then List.filter (function { tdata = TSetBgColor _ } -> false | _ -> true) tags1 else tags1 in
|
|
|
+ (* remove unused tags *)
|
|
|
+ let use_stage = Common.defined com "flash_use_stage" in
|
|
|
+ let classes = ref [] in
|
|
|
+ let nframe = ref 0 in
|
|
|
+ let tags2 = List.filter (fun t ->
|
|
|
+ match t.tdata with
|
|
|
+ | TPlaceObject2 _
|
|
|
+ | TPlaceObject3 _
|
|
|
+ | TRemoveObject2 _
|
|
|
+ | TRemoveObject _ -> use_stage
|
|
|
+ | TShowFrame -> incr nframe; use_stage
|
|
|
+ | TFilesAttributes _ | TEnableDebugger2 _ | TF9Scene _ -> false
|
|
|
+ | TSetBgColor _ -> priority
|
|
|
+ | TF9Classes el ->
|
|
|
+ if com.flash_version < 9 then failwith "You can't use AS3 SWF with Flash8 target";
|
|
|
+ if !nframe <> 0 then failwith "Classes export found outside of Frame 1";
|
|
|
+ classes := !classes @ List.filter (fun e -> e.f9_cid <> None) el; false
|
|
|
+ | _ -> true
|
|
|
+ ) tags2 in
|
|
|
+ (* rebuild character ids *)
|
|
|
+ let max_id = ref (-1) in
|
|
|
+ List.iter (SwfParser.scan (fun id -> if id > !max_id then max_id := id; id) (fun id -> id)) tags1;
|
|
|
+ incr max_id;
|
|
|
+ let rec loop t =
|
|
|
+ SwfParser.scan (fun id -> id + !max_id) (fun id -> id + !max_id) t;
|
|
|
+ match t.tdata with
|
|
|
+ | TClip c -> List.iter loop c.c_tags
|
|
|
+ | _ -> ()
|
|
|
+ in
|
|
|
+ List.iter loop tags2;
|
|
|
+ let classes = List.map (fun e -> match e.f9_cid with None -> e | Some id -> { e with f9_cid = Some (id + !max_id) }) !classes in
|
|
|
+ (* do additional transforms *)
|
|
|
+ let tags2 = List.map (fun t ->
|
|
|
+ match t.tdata with
|
|
|
+ | TActionScript3 (id,data) -> { t with tdata = TActionScript3 (id,make_as3_public data) }
|
|
|
+ | _ -> t
|
|
|
+ ) tags2 in
|
|
|
+ (* merge timelines *)
|
|
|
+ let rec loop l1 l2 =
|
|
|
+ match l1, l2 with
|
|
|
+ | ({ tdata = TSetBgColor _ } as t) :: l1, _
|
|
|
+ | ({ tdata = TEnableDebugger2 _ } as t) :: l1, _
|
|
|
+ | ({ tdata = TFilesAttributes _ } as t) :: l1, _ ->
|
|
|
+ t :: loop l1 l2
|
|
|
+ | _, ({ tdata = TSetBgColor _ } as t) :: l2 ->
|
|
|
+ t :: loop l1 l2
|
|
|
+ | { tdata = TShowFrame } :: l1, { tdata = TShowFrame } :: l2 ->
|
|
|
+ tag TShowFrame :: loop l1 l2
|
|
|
+ | { tdata = TShowFrame } :: _, x :: l2 ->
|
|
|
+ (* wait until we finish frame on other swf *)
|
|
|
+ x :: loop l1 l2
|
|
|
+ | { tdata = TF9Classes el } :: l1, _ ->
|
|
|
+ (* merge all classes together *)
|
|
|
+ tag (TF9Classes (classes @ el)) :: loop l1 l2
|
|
|
+ | _ , x :: l2 ->
|
|
|
+ x :: loop l1 l2
|
|
|
+ | x :: l1, [] ->
|
|
|
+ x :: loop l1 l2
|
|
|
+ | [], [] ->
|
|
|
+ []
|
|
|
+ in
|
|
|
+ let tags = loop tags1 tags2 in
|
|
|
+ header, tags
|
|
|
+
|
|
|
+let generate com swf_header swf_libs =
|
|
|
+ let t = Common.timer "generate swf" in
|
|
|
+ let isf9 = com.flash_version >= 9 in
|
|
|
+ let swc = if Common.defined com "swc" then Some (ref "") else None in
|
|
|
+ if swc <> None && not isf9 then failwith "SWC support is only available for Flash9+";
|
|
|
+ let file , codeclip = (try let f , c = ExtString.String.split com.file "@" in f, Some c with _ -> com.file , None) in
|
|
|
+ (* list exports *)
|
|
|
+ let exports = Hashtbl.create 0 in
|
|
|
+ List.iter (fun lib ->
|
|
|
+ let _, tags = lib() in
|
|
|
+ List.iter (fun t ->
|
|
|
+ match t.tdata with
|
|
|
+ | TExport l -> List.iter (fun e -> Hashtbl.add exports e.exp_name ()) l
|
|
|
+ | _ -> ()
|
|
|
+ ) tags;
|
|
|
+ ) swf_libs;
|
|
|
+ (* build haxe swf *)
|
|
|
+ let tags = if isf9 then build_swf9 com swc else build_swf8 com codeclip exports in
|
|
|
+ let header, bg = (match swf_header with None -> default_header com | Some h -> convert_header com h) in
|
|
|
+ let bg = tag (TSetBgColor { cr = bg lsr 16; cg = (bg lsr 8) land 0xFF; cb = bg land 0xFF }) in
|
|
|
+ let debug = (if isf9 && Common.defined com "fdb" then [tag (TEnableDebugger2 (0,""))] else []) in
|
|
|
+ let fattr = (if com.flash_version < 8 then [] else
|
|
|
+ [tag (TFilesAttributes {
|
|
|
+ fa_network = Common.defined com "network-sandbox";
|
|
|
+ fa_as3 = isf9;
|
|
|
+ fa_metadata = false;
|
|
|
+ fa_gpu = false;
|
|
|
+ fa_direct_blt = false;
|
|
|
+ })]
|
|
|
) in
|
|
|
+ let swf = header, fattr @ bg :: debug @ tags @ [tag TShowFrame] in
|
|
|
+ (* merge swf libraries *)
|
|
|
+ let priority = ref (swf_header = None) in
|
|
|
+ let swf = List.fold_left (fun swf lib ->
|
|
|
+ let swf = merge com !priority swf (lib()) in
|
|
|
+ priority := false;
|
|
|
+ swf
|
|
|
+ ) swf swf_libs in
|
|
|
t();
|
|
|
+ (* write swf/swc *)
|
|
|
let t = Common.timer "write swf" in
|
|
|
- if Common.defined com "swc" then begin
|
|
|
+ (match swc with
|
|
|
+ | Some cat ->
|
|
|
let ch = IO.output_strings() in
|
|
|
Swf.write ch swf;
|
|
|
let swf = IO.close_out ch in
|
|
|
let ch = IO.output_channel (open_out_bin file) in
|
|
|
let z = zip_create ch in
|
|
|
- zip_write_file z "catalog.xml" ctx.swc_catalog (Unix.time()) true;
|
|
|
+ zip_write_file z "catalog.xml" (!cat) (Unix.time()) true;
|
|
|
zip_write_file z "library.swf" (match swf with [s] -> s | _ -> failwith "SWF too big for SWC") (Unix.time()) false;
|
|
|
zip_write_cdr z;
|
|
|
IO.close_out ch;
|
|
|
- end else begin
|
|
|
+ | None ->
|
|
|
let ch = IO.output_channel (open_out_bin file) in
|
|
|
Swf.write ch swf;
|
|
|
IO.close_out ch;
|
|
|
- end;
|
|
|
+ );
|
|
|
t()
|
|
|
|
|
|
;;
|
|
|
SwfParser.init Extc.input_zip Extc.output_zip;
|
|
|
-SwfParser.full_parsing := false;
|
|
|
-SwfParser.force_as3_parsing := true;
|
|
|
Swf.warnings := false;
|
Nicolas Cannasse