open OptParse
type output_type =
- Ho | Abc | Abcx | Swfx | Swf
+ Ho | Abc | Swf
type scm = {
scm_cmd: string;
link_std: bool
}
-type abc = {
- abc_cmd: string
-}
-
-type abcx = {
- abcx_cmd: string;
- template: string;
+type link = {
+ link_cmd: string;
size: int * int;
bg_color: Color.t;
}
-type swfx = {
- swfx_cmd:string;
-}
-
type general = {
verbose: bool;
just_print: bool;
output: string;
general: general;
scm: scm;
- abc: abc;
- abcx: abcx;
- swfx: swfx;
+ link: link;
}
let opt_parser =
link_std = Opt.get no_std
}
-let abc =
- let cmd =
- str_option
- ~default:(Config.bin_dir ^ "/habc-xml" ^ Config.exe)
- ~metavar:"<cmd>"
- ~long_name:"abcx"
- ~help:"Use <cmd> to compile abc to abcx" () in
- fun () -> {
- abc_cmd = Opt.get cmd
- }
-
-let abcx =
+let link =
let cmd =
str_option
- ~default:"m4"
+ ~default:(Config.bin_dir ^ "/habc-link" ^ Config.exe)
~metavar:"<cmd>"
- ~long_name:"swfx"
- ~help:"Use <cmd> to compile abcx to swfx" () in
+ ~long_name:"link"
+ ~help:"Use <cmd> to compile abc to swf" () in
let width =
int_option
~default:800
~metavar:"<color>"
~long_name:"bg"
~help:"stage background color" () in
- let template =
- str_option
- ~default:Config.default_template
- ~metavar:"<tempalte>"
- ~long_name:"template"
- ~help:"swfx template" () in
fun () -> {
- abcx_cmd = Opt.get cmd;
+ link_cmd = Opt.get cmd;
bg_color = Color.parse @@ Opt.get bg_color;
size = (20 * Opt.get width,20 * Opt.get height); (* convert pixel to twips *)
- template = Opt.get template;
- }
-
-let swfx =
- let cmd =
- str_option
- ~default:"swfmill"
- ~metavar:"<cmd>"
- ~long_name:"swf"
- ~help:"Use <cmd> to compile swfx to swf" () in
- fun () -> {
- swfx_cmd = Opt.get cmd
}
let general =
let abc =
bool_option
~default:false ~long_name:"abc-stage" ~help:"(no doc)" () in
- let abcx =
- bool_option
- ~default:false ~long_name:"abcx-stage" ~help:"(no doc)" () in
- let swfx =
- bool_option
- ~default:false ~long_name:"swfx-stage" ~help:"(no doc)" () in
fun () ->
if Opt.get ho then
Ho
else if Opt.get abc then
Abc
- else if Opt.get abcx then
- Abcx
- else if Opt.get swfx then
- Swfx
else
Swf
match output_type () with
Ho -> ".ho"
| Abc -> ".abc"
- | Abcx -> ".abcx"
- | Swfx -> ".swfx"
| Swf -> ".swf" in
{
- inputs = inputs;
- output = o;
- general = general ();
- scm = scm ();
- abc = abc ();
- abcx = abcx ();
- swfx = swfx ();
+ inputs = inputs;
+ output = o;
+ general = general ();
+ scm = scm ();
+ link = link ();
}
let rules = [
- one_to_one "scm" "ho"
- (fun {scm = {scm_cmd=scm_cmd; includes=includes; link_std=link_std}} input output ->
+ one_to_one "scm" "ho" begin fun {scm = {scm_cmd=scm_cmd; includes=includes; link_std=link_std}} input output ->
[Printf.sprintf "%s -c -I %s -o %s %s %s"
scm_cmd includes output
(if link_std then "std.ho" else "")
- input ]);
- many_to_one ["scm"] "abc"
- (fun {scm = {scm_cmd=scm_cmd; includes=includes;link_std=link_std}} inputs output ->
- [Printf.sprintf "%s -I %s -o %s %s %s"
- scm_cmd includes output
- (if link_std then "std.ho" else "")
- @@ String.concat " " inputs ]);
- many_to_one ["scm";"ho"] "abc"
- (fun {scm = {scm_cmd=scm_cmd; includes=includes}} inputs output ->
+ input ]
+ end;
+ many_to_one ["scm"] "abc" begin fun {scm = {scm_cmd=scm_cmd; includes=includes;link_std=link_std}} inputs output ->
+ [Printf.sprintf "%s -I %s -o %s %s %s"
+ scm_cmd includes output
+ (if link_std then "std.ho" else "")
+ @@ String.concat " " inputs ]
+ end;
+ many_to_one ["scm";"ho"] "abc" begin fun {scm = {scm_cmd=scm_cmd; includes=includes}} inputs output ->
[Printf.sprintf "%s -I %s -o %s %s"
- scm_cmd includes output @@ String.concat " " inputs ]);
- many_to_one ["ho"] "abc"
- (fun {scm = {scm_cmd=scm_cmd; includes=includes}} inputs output ->
+ scm_cmd includes output @@ String.concat " " inputs ]
+ end;
+ many_to_one ["ho"] "abc" begin fun {scm = {scm_cmd=scm_cmd; includes=includes}} inputs output ->
[Printf.sprintf "%s -I %s -o %s %s"
- scm_cmd includes output @@ String.concat " " inputs ]);
- one_to_one "abc" "abcx"
- (fun {abc = {abc_cmd=abc_cmd}} input output ->
- [Printf.sprintf "%s %s > %s" abc_cmd input output]);
- one_to_one "abcx" "swfx"
- (fun { abcx = {
- abcx_cmd = m4;
- template = template;
- size = (w,h);
- bg_color = {Color.red=r; green=g; blue=b};
- }} input output ->
- [Printf.sprintf "%s -I. %s %s > %s"
- m4
- (m4_opt [
- "__ABCX__" ,input;
- "__MAIN_CLASS__","boot.Boot";
- "__WIDTH__" ,string_of_int w;
- "__HEIGHT__" ,string_of_int h;
- "__BG_RED__" ,string_of_int r;
- "__BG_GREEN__" ,string_of_int g;
- "__BG_BLUE__" ,string_of_int b;
- ])
- template output]);
- one_to_one "swfx" "swf"
- (fun { swfx = { swfx_cmd=swfx_cmd } } input output ->
- [Printf.sprintf "%s xml2swf %s %s" swfx_cmd input output]);
+ scm_cmd includes output @@ String.concat " " inputs ]
+ end;
+ one_to_one "abc" "swf" begin fun { link = {
+ link_cmd=link_cmd;
+ size=(w,h);
+ bg_color = {Color.red=r; green=g; blue=b}; }}
+ input output ->
+ [Printf.sprintf "%s --width=%d --height=%d --red=%d --green=%d --blue=%d --main=boot.Boot --output=%s %s"
+ link_cmd w h r g b output input]
+ end;
]
let debug verbose str =
if verbose then begin
Printf.eprintf "--> %s\n" str;
- flush stderr
+ flush stderr;
+ flush stdout
end
let system {general={verbose=verbose}} cmd =
debug verbose cmd';
Unix.system cmd'
-let execute _ commands =
- open Unix in
+let execute ctx commands =
List.iter (fun s ->
- match system s with
+ match system ctx s with
Unix.WEXITED 0 ->
()
- | Unix.WEXITED n | WSIGNALED n | WSTOPPED n ->
+ | Unix.WEXITED n | Unix.WSIGNALED n | Unix.WSTOPPED n ->
prerr_endline "BUILD ERROR";
exit n)
commands
verbose ctx @@ Printf.sprintf "Target: [%s] => %s\n" (String.concat "; " inputs) output in
let commands =
Rule.commands ctx rules inputs output in
- if ctx.general.just_print then
+ if commands = [] then
+ failwith "no rule"
+ else if ctx.general.just_print then
List.iter print_endline commands
else begin
execute ctx commands;
OSDN Git Service
