link/cmdOpt.ml

   1 open Base
   2 open OptParse
   3
   4 class type t = object
   5   method color:int*int*int
   6   method size:int*int
   7   method main_class:string
   8   method output:string
   9   method use_network:bool
  10 end
  11
  12 let opt_parser =
  13   OptParser.make
  14     ~version:Config.version
  15     ~usage:"habc-link [options] <file>" ()
  16
  17 let str_option ~default ~metavar ?short_name ?long_name ~help () =
  18   let store =
  19     StdOpt.str_option ~default ~metavar () in
  20   let _ =
  21     OptParser.add opt_parser
  22       ?short_name
  23       ?long_name ~help store in
  24     store
  25
  26 let int_option ~default ~metavar ?short_name ?long_name ~help () =
  27   let store =
  28     StdOpt.int_option ~default ~metavar () in
  29   let _ =
  30     OptParser.add opt_parser
  31       ?short_name ?long_name ~help store in
  32     store
  33
  34 let bool_option ~default ?short_name ?long_name ~help () =
  35   let store =
  36     if default then
  37       StdOpt.store_false ()
  38     else
  39       StdOpt.store_true () in
  40   let _ =
  41     OptParser.add opt_parser
  42       ?short_name ?long_name ~help store in
  43     store
  44
  45 let width =
  46   int_option
  47     ~default:(20 * 800)
  48     ~metavar:"<width>"
  49     ~short_name:'W'
  50     ~long_name:"width"
  51     ~help:"Set stage width by twips" ()
  52
  53 let height =
  54   int_option
  55     ~default:(20 * 600)
  56     ~metavar:"<height>"
  57     ~short_name:'H'
  58     ~long_name:"height"
  59     ~help:"Set stage height by pixel" ()
  60
  61 let main_class =
  62   str_option
  63     ~default:"boot.Boot"
  64     ~metavar:"<main_class>"
  65     ~short_name:'m'
  66     ~long_name:"main"
  67     ~help:"Set main class" ()
  68
  69 let output =
  70   str_option
  71     ~default:"a.swf"
  72     ~metavar:"<output swf>"
  73     ~short_name:'o'
  74     ~long_name:"output"
  75     ~help:"Set output name" ()
  76
  77 let red =
  78   int_option
  79     ~default:134
  80     ~metavar:"<red>"
  81     ~long_name:"red"
  82     ~help:"stage background color(red)" ()
  83
  84 let green =
  85   int_option
  86     ~default:156
  87     ~metavar:"<green>"
  88     ~long_name:"green"
  89     ~help:"stage background color(green)" ()
  90
  91 let blue =
  92   int_option
  93     ~default:167
  94     ~metavar:"<blue>"
  95     ~long_name:"blue"
  96     ~help:"stage background color(blue)" ()
  97
  98 let use_network =
  99   bool_option
 100     ~default:false
 101     ~long_name:"use-network"
 102     ~help:"Set use_network option" ()
 103
 104 let parse argv =
 105   let inputs =
 106     OptParser.parse ~first:1 opt_parser argv in
 107     inputs,{|
 108       color       = (Opt.get red, Opt.get green, Opt.get blue);
 109       main_class  = Opt.get main_class;
 110       size        = (Opt.get width, Opt.get height);
 111       output      = Opt.get output;
 112       use_network = Opt.get use_network
 113     |}
 114
 115 let parse_argv () =
 116   parse Sys.argv