sig
  module Ming :
    sig
      external init : unit -> int = "ml_ming_init"
      external cleanup : unit -> unit = "ml_ming_cleanup"
      external collect_garbage : unit -> unit = "ml_ming_collectgarbage"
      external set_cubic_threshold : num:int -> unit
        = "ml_ming_setcubicthreshold"
      external set_scale : scale:float -> unit = "ml_ming_setscale"
      external get_scale : unit -> float = "ml_ming_getscale"
      external use_swf_version : version:int -> unit
        = "ml_ming_useswfversion"
      external set_swf_compression : level:int -> int
        = "ml_ming_setswfcompression"
    end
  val get_content_type : unit -> string
  type input
  module Input :
    sig
      external new_from_file : filename:string -> modes:string -> SWF.input
        = "ml_newswfinput_file"
      external destroy : input:SWF.input -> unit = "ml_destroyswfinput"
      external get_length : input:SWF.input -> int = "ml_swfinput_length"
    end
  type character
  module Character :
    sig
      external get_width : SWF.character -> float
        = "ml_swfcharacter_getwidth"
      external get_height : SWF.character -> float
        = "ml_swfcharacter_getheight"
    end
  type bitmap
  type shape
  type morph
  type sound
  type sprite
  external bitmap_of_character : SWF.character -> SWF.bitmap = "ml_id"
  external shape_of_character : SWF.character -> SWF.shape = "ml_id"
  external morph_of_character : SWF.character -> SWF.morph = "ml_id"
  external sound_of_character : SWF.character -> SWF.sound = "ml_id"
  external sprite_of_character : SWF.character -> SWF.sprite = "ml_id"
  external character_of_bitmap : SWF.bitmap -> SWF.character = "ml_id"
  external character_of_shape : SWF.shape -> SWF.character = "ml_id"
  external character_of_morph : SWF.morph -> SWF.character = "ml_id"
  external character_of_sound : SWF.sound -> SWF.character = "ml_id"
  external character_of_sprite : SWF.sprite -> SWF.character = "ml_id"
  module Bitmap :
    sig
      external new_from_input : input:SWF.input -> SWF.bitmap
        = "ml_newswfbitmap_frominput"
      external destroy : bitmap:SWF.bitmap -> unit = "ml_destroyswfbitmap"
      external get_width : bitmap:SWF.bitmap -> int = "ml_swfbitmap_getwidth"
      external get_height : bitmap:SWF.bitmap -> int
        = "ml_swfbitmap_getheight"
    end
  type jpeg_bitmap
  module JpegBitmap :
    sig
      external new_from_file :
        filename:string -> modes:string -> SWF.jpeg_bitmap
        = "ml_newswfjpegbitmap"
    end
  type gradient
  module Gradient :
    sig
      external new_gradient : unit -> SWF.gradient = "ml_newswfgradient"
      external destroy : gradient:SWF.gradient -> unit
        = "ml_destroyswfgradient"
      external add_entry :
        gradient:SWF.gradient ->
        ratio:float -> r:int -> g:int -> b:int -> a:int -> unit
        = "ml_swfgradient_addentry_bytecode" "ml_swfgradient_addentry_native"
    end
  type fill_style
  module FillStyle :
    sig
      external new_solid : r:int -> g:int -> b:int -> a:int -> SWF.fill_style
        = "ml_newswfsolidfillstyle"
    end
  type line_style
  module LineStyle :
    sig
      external new_line_style :
        width:int -> r:int -> g:int -> b:int -> a:int -> SWF.line_style
        = "ml_newswflinestyle"
    end
  type fill
  type font
  module Shape :
    sig
      external new_shape : unit -> SWF.shape = "ml_newswfshape"
      external destroy : shape:SWF.shape -> unit = "ml_destroyswfshape"
      external add_solid_fill :
        shape:SWF.shape -> r:int -> g:int -> b:int -> a:int -> SWF.fill
        = "ml_swfshape_addsolidfill"
      external set_line :
        shape:SWF.shape ->
        width:int -> r:int -> g:int -> b:int -> a:int -> unit
        = "ml_swfshape_setline_bytecode" "ml_swfshape_setline_native"
      external set_line_style :
        shape:SWF.shape ->
        width:int -> r:int -> g:int -> b:int -> a:int -> unit
        = "ml_swfshape_setlinestyle_bytecode"
        "ml_swfshape_setlinestyle_native"
      external hide_line : shape:SWF.shape -> unit = "ml_swfshape_hideline"
      external move_pen : shape:SWF.shape -> x:float -> y:float -> unit
        = "ml_swfshape_movepen"
      external move_pen_to : shape:SWF.shape -> x:float -> y:float -> unit
        = "ml_swfshape_movepento"
      external draw_line : shape:SWF.shape -> x:float -> y:float -> unit
        = "ml_swfshape_drawline"
      external draw_line_to : shape:SWF.shape -> x:float -> y:float -> unit
        = "ml_swfshape_drawlineto"
      external draw_curve :
        shape:SWF.shape ->
        controlx:float ->
        controly:float -> anchorx:float -> anchory:float -> unit
        = "ml_swfshape_drawcurve"
      external draw_curve_to :
        shape:SWF.shape ->
        controlx:float ->
        controly:float -> anchorx:float -> anchory:float -> unit
        = "ml_swfshape_drawcurveto"
      external draw_circle : shape:SWF.shape -> r:float -> unit
        = "ml_swfshape_drawcircle"
      external draw_arc :
        shape:SWF.shape ->
        r:float -> start_angle:float -> end_angle:float -> unit
        = "ml_swfshape_drawarc"
      external draw_glyph :
        shape:SWF.shape -> font:SWF.font -> c:char -> unit
        = "ml_swfshape_drawglyph"
      external set_right_fill_style :
        shape:SWF.shape -> fill_style:SWF.fill_style -> unit
        = "ml_swfshape_setrightfillstyle"
      external set_left_fill_style :
        shape:SWF.shape -> fill_style:SWF.fill_style -> unit
        = "ml_swfshape_setleftfillstyle"
      external set_right_fill : shape:SWF.shape -> fill:SWF.fill -> unit
        = "ml_swfshape_setrightfill"
      external set_left_fill : shape:SWF.shape -> fill:SWF.fill -> unit
        = "ml_swfshape_setleftfill"
      external add_linear_gradient_fill :
        shape:SWF.shape -> gradient:SWF.gradient -> SWF.fill
        = "ml_swfshape_addgradientfill_linear"
      external add_radial_gradient_fill :
        shape:SWF.shape -> gradient:SWF.gradient -> SWF.fill
        = "ml_swfshape_addgradientfill_radial"
    end
  module Morph :
    sig
      external new_morph : unit -> SWF.morph = "ml_newswfmorphshape"
      external destroy : morph:SWF.morph -> unit = "ml_destroyswfmorph"
      external get_shape1 : morph:SWF.morph -> SWF.shape
        = "ml_swfmorph_getshape1"
      external get_shape2 : morph:SWF.morph -> SWF.shape
        = "ml_swfmorph_getshape2"
    end
  module Font :
    sig
      external new_font : unit -> SWF.font = "ml_newswffont"
      external load_from_file : filename:string -> SWF.font
        = "ml_loadswffontfromfile"
      external destroy : font:SWF.font -> unit = "ml_destroyswffont"
      external get_string_width : font:SWF.font -> string:string -> float
        = "ml_swffont_getstringwidth"
      external get_ascent : font:SWF.font -> float = "ml_swffont_getascent"
      external get_descent : font:SWF.font -> float = "ml_swffont_getdescent"
      external get_leading : font:SWF.font -> float = "ml_swffont_getleading"
    end
  type action
  module Action :
    sig
      external compile_code : script:string -> SWF.action
        = "ml_compileswfactioncode"
      external destroy : action:SWF.action -> unit = "ml_destroyswfaction"
    end
  type display_item
  module DisplayItem :
    sig
      external set_color_mult :
        display_item:SWF.display_item ->
        r:float -> g:float -> b:float -> a:float -> unit
        = "ml_swfdisplayitem_setcolormult"
      external move :
        display_item:SWF.display_item -> x:float -> y:float -> unit
        = "ml_swfdisplayitem_move"
      external move_to :
        display_item:SWF.display_item -> x:float -> y:float -> unit
        = "ml_swfdisplayitem_moveto"
      external rotate :
        display_item:SWF.display_item -> degrees:float -> unit
        = "ml_swfdisplayitem_rotate"
      external rotate_to :
        display_item:SWF.display_item -> degrees:float -> unit
        = "ml_swfdisplayitem_rotateto"
      external scale :
        display_item:SWF.display_item -> x:float -> y:float -> unit
        = "ml_swfdisplayitem_scale"
      external scale_to :
        display_item:SWF.display_item -> x:float -> y:float -> unit
        = "ml_swfdisplayitem_scaleto"
      external skew_x : display_item:SWF.display_item -> x:float -> unit
        = "ml_swfdisplayitem_skewx"
      external skew_x_to : display_item:SWF.display_item -> x:float -> unit
        = "ml_swfdisplayitem_skewxto"
      external set_ratio :
        display_item:SWF.display_item -> ratio:float -> unit
        = "ml_swfdisplayitem_setratio"
    end
  module Fill :
    sig
      external new_fill : fill_style:SWF.fill_style -> SWF.fill
        = "ml_newswffill"
      external destroy : fill:SWF.fill -> unit = "ml_destroyswffill"
      external scale_xy_to : fill:SWF.fill -> x:float -> y:float -> unit
        = "ml_swffill_scalexyto"
      external scale_xy : fill:SWF.fill -> x:float -> y:float -> unit
        = "ml_swffill_scalexy"
      external scale_x_to : fill:SWF.fill -> x:float -> unit
        = "ml_swffill_scalexto"
      external scale_x : fill:SWF.fill -> x:float -> unit
        = "ml_swffill_scalex"
      external scale_y_to : fill:SWF.fill -> y:float -> unit
        = "ml_swffill_scaleyto"
      external scale_y : fill:SWF.fill -> y:float -> unit
        = "ml_swffill_scaley"
      external skew_x_to : fill:SWF.fill -> x:float -> unit
        = "ml_swffill_skewxto"
      external skew_x : fill:SWF.fill -> x:float -> unit = "ml_swffill_skewx"
      external skew_y_to : fill:SWF.fill -> y:float -> unit
        = "ml_swffill_skewyto"
      external skew_y : fill:SWF.fill -> y:float -> unit = "ml_swffill_skewy"
      external move_to : fill:SWF.fill -> x:float -> y:float -> unit
        = "ml_swffill_moveto"
      external move : fill:SWF.fill -> x:float -> y:float -> unit
        = "ml_swffill_move"
      external rotate_to : fill:SWF.fill -> degrees:float -> unit
        = "ml_swffill_rotateto"
      external rotate : fill:SWF.fill -> degrees:float -> unit
        = "ml_swffill_rotate"
    end
  type movie_clip
  type block
  external block_of_shape : shape:SWF.shape -> SWF.block = "ml_id"
  external block_of_morph : morph:SWF.morph -> SWF.block = "ml_id"
  module MovieClip :
    sig
      external new_movie_clip : unit -> SWF.movie_clip = "ml_newswfmovieclip"
      external destroy : movie_clip:SWF.movie_clip -> unit
        = "ml_destroyswfmovieclip"
      external add :
        movie_clip:SWF.movie_clip -> block:SWF.block -> SWF.display_item
        = "ml_swfmovieclip_add"
      external next_frame : movie_clip:SWF.movie_clip -> unit
        = "ml_swfmovieclip_nextframe"
    end
  type movie
  external block_of_movie_clip : movie_clip:SWF.movie_clip -> SWF.block
    = "ml_id"
  module Movie :
    sig
      external new_movie : unit -> SWF.movie = "ml_newswfmovie"
      external destroy : movie:SWF.movie -> unit = "ml_destroyswfmovie"
      external add : movie:SWF.movie -> block:SWF.block -> SWF.display_item
        = "ml_swfmovie_add"
      external remove :
        movie:SWF.movie -> display_item:SWF.display_item -> unit
        = "ml_swfmovie_remove"
      external set_background :
        movie:SWF.movie -> r:int -> g:int -> b:int -> unit
        = "ml_swfmovie_setbackground"
      external set_dimension : movie:SWF.movie -> x:float -> y:float -> unit
        = "ml_swfmovie_setdimension"
      external save : movie:SWF.movie -> filename:string -> int
        = "ml_swfmovie_save"
      external set_rate : movie:SWF.movie -> rate:float -> unit
        = "ml_swfmovie_setrate"
      external next_frame : movie:SWF.movie -> unit = "ml_swfmovie_nextframe"
    end
  module OO :
    sig
      class swfFill :
        fill:SWF.fill ->
        object
          val fill : SWF.fill
          method get_fill : unit -> SWF.fill
          method move : x:float -> y:float -> unit
          method move_to : x:float -> y:float -> unit
          method rotate : degrees:float -> unit
          method rotate_to : degrees:float -> unit
          method scale : scale:float -> unit
          method scale_to : scale:float -> unit
          method scale_x : x:float -> unit
          method scale_x_to : x:float -> unit
          method scale_xy : x:float -> y:float -> unit
          method scale_xy_to : x:float -> y:float -> unit
          method scale_y : y:float -> unit
          method scale_y_to : y:float -> unit
          method skew_x : x:float -> unit
          method skew_x_to : x:float -> unit
          method skew_y : y:float -> unit
          method skew_y_to : y:float -> unit
        end
      class swfGradient :
        object
          val gradient : SWF.gradient
          method add_entry :
            ratio:float -> r:int -> g:int -> b:int -> a:int -> unit
          method get_gradient : unit -> SWF.gradient
        end
      class swfFont :
        filename:string ->
        object
          val font : SWF.font
          method get_ascent : unit -> float
          method get_descent : unit -> float
          method get_font : unit -> SWF.font
          method get_leading : unit -> float
          method get_width : string:string -> float
        end
      class swfDisplayItem :
        display_item:SWF.display_item ->
        object
          val display_item : SWF.display_item
          method move : x:float -> y:float -> unit
          method move_to : x:float -> y:float -> unit
          method rotate : degrees:float -> unit
          method rotate_to : degrees:float -> unit
          method scale : x:float -> y:float -> unit
          method scale_to : x:float -> y:float -> unit
          method set_color_mult :
            r:float -> g:float -> b:float -> a:float -> unit
          method set_ratio : ratio:float -> unit
          method skew_x : x:float -> unit
          method skew_x_to : x:float -> unit
        end
      class swfShape :
        ?shape:SWF.shape ->
        unit ->
        object
          val shape : SWF.shape
          method add_fill :
            r:int -> g:int -> b:int -> a:int -> SWF.OO.swfFill
          method add_linear_gradient_fill :
            gradient:SWF.OO.swfGradient -> SWF.OO.swfFill
          method add_radial_gradient_fill :
            gradient:SWF.OO.swfGradient -> SWF.OO.swfFill
          method add_solid_fill :
            r:int -> g:int -> b:int -> a:int -> SWF.OO.swfFill
          method draw_arc :
            r:float -> start_angle:float -> end_angle:float -> unit
          method draw_circle : r:float -> unit
          method draw_curve :
            controlx:float ->
            controly:float -> anchorx:float -> anchory:float -> unit
          method draw_curve_to :
            controlx:float ->
            controly:float -> anchorx:float -> anchory:float -> unit
          method draw_glyph : font:SWF.OO.swfFont -> c:char -> unit
          method draw_line : x:float -> y:float -> unit
          method draw_line_to : x:float -> y:float -> unit
          method get_block : unit -> SWF.block
          method get_shape : unit -> SWF.shape
          method hide_line : unit -> unit
          method move_pen : x:float -> y:float -> unit
          method move_pen_to : x:float -> y:float -> unit
          method set_left_fill : fill:SWF.OO.swfFill -> unit
          method set_left_fill_style : fill_style:SWF.fill_style -> unit
          method set_line :
            width:int -> r:int -> g:int -> b:int -> a:int -> unit
          method set_line_style :
            width:int -> r:int -> g:int -> b:int -> a:int -> unit
          method set_right_fill : fill:SWF.OO.swfFill -> unit
          method set_right_fill_style : fill_style:SWF.fill_style -> unit
        end
      class swfMorph :
        object
          val morph : SWF.morph
          method get_morph : unit -> SWF.morph
          method get_shape1 : unit -> SWF.OO.swfShape
          method get_shape2 : unit -> SWF.OO.swfShape
        end
      type item = SWFShape of SWF.OO.swfShape | SWFMorph of SWF.OO.swfMorph
      class swfMovie :
        object
          val mutable filesize : int option
          val movie : SWF.movie
          method add : block:SWF.OO.item -> SWF.OO.swfDisplayItem
          method get_filesize : unit -> int option
          method next_frame : unit -> unit
          method save : filename:string -> unit
          method set_background : r:int -> g:int -> b:int -> unit
          method set_dimension : x:float -> y:float -> unit
          method set_rate : rate:float -> unit
        end
    end
end