module WriteFig

  ! Write xfig objects

  implicit NONE
  public

  type :: Arrow
    integer :: Type          ! 1: Stick, 2: Closed, 3: Indented, 4: Pointed butt
    integer :: Style         ! 0: Hollow, 1: Filled
    real :: Thick            ! 1/80 inch
    real :: Width            ! FIG units
    real :: Height           ! FIG units
  end type Arrow

contains

  subroutine WritePoly ( Sub, Points, Style, Thick, Pen_Color, Fill_Color, &
    &                    Depth, Area_Fill, Style_Val, Join_Style, &
    &                    Cap_Style, Radius, Forward_Arrow, Backward_Arrow, Unit  )
    integer, intent(in) :: Sub         ! 1: Polyline 2: Box 3: Polygon
                                       ! 4: Arc-box
    integer, intent(in) :: Points(:,:) ! FIG units, x1, y1, x2, y2, ...
    integer, intent(in), optional :: Style      ! -1: Default 0: Solid 1: -
                                       ! 2: . 3: -. 4: -. 5: -..., default 0
    integer, intent(in), optional :: Thick      ! 1/80 inch, default 1
    integer, intent(in), optional :: Pen_Color  ! -1: default 0: Black 1: Blue
      ! 2: Green 3: Cyan 4: Red 5: Magenta 6: Yellow 7: White
      ! 8-11: Four shades of blue (dark to light) 12-14: Three shades of green
      ! 14-17: Three shades of cyan 18-20: Three shades of red
      ! 21-23: Three shades of magenta 23-26: Three shades of brown
      ! 27-30: Four shades of pink 31: Gold 32-543: Defined by color object
      ! Default 0
    integer, intent(in), optional :: Fill_Color ! default 7
    integer, intent(in), optional :: Depth      ! default 50
    integer, intent(in), optional :: Area_Fill  ! -1: not filled
      ! 0-19: Shades (dark to light) color mixed with black so 0 is black
      ! 20-39: Saturation (proportion of white -20)/20
      ! 40: White 41: 30-degree left diagonal pattern 42: 30-degree right
      ! diagonal pattern 43: 30-degree crosshatch 44: 45-degree left
      ! diagonal pattern 45: 45-degree right diagonal pattern 46: 45-degree
      ! crosshatch 47: horizontal bricks 48: vertical bricks 49: horizontal
      ! lines 50: vertical lines 51: crosshatch 52: horizontal shingles
      ! skewed to right 53: horizontal shingles skewed to left 54: horizontal
      ! shingles skewed one way 55: horizontal shingles skewed the other way
      ! 56: fish scales 57: small fish scales 58: circles 59: hexagons
      ! 60: octagons 61: horizontal tire treads 62: vertical tire treads
      ! default -1
    real, intent(in), optional :: Style_Val ! 1/80 inch, default 0.000
    integer, intent(in), optional :: Join_Style ! 0: Miter 1: round 2: bevel
                                     ! default 0
    integer, intent(in), optional :: Cap_Style  ! 0: Butt 1: round 2: projecting
                                     ! default 0
    integer, intent(in), optional :: Radius     ! 1/80 inch, of arc boxes
    type(arrow), intent(in), optional :: Forward_Arrow, Backward_Arrow
    integer, intent(in), optional :: Unit       ! 0 = stdout, default 0

    integer :: My_Style, My_Thick, My_Pen_Color, My_Fill_Color, My_Depth
    integer :: My_Area_Fill, My_Join_Style, My_Cap_Style, My_Radius, My_Unit
    integer :: My_Forward_Arrow, My_Backward_Arrow
    real :: My_Style_Val

    my_style = 0
    my_thick = 1
    my_pen_color = 0
    my_fill_color = 7
    my_depth = 50
    my_area_fill = -1
    my_style_val = 0.0
    my_join_style = 0
    my_cap_style = 0
    my_radius = 0
    my_forward_arrow = 0
    my_backward_arrow = 0
    my_unit = 0

    if ( present(style) ) my_style = style
    if ( present(thick) ) my_thick = thick
    if ( present(pen_color) ) my_pen_color = pen_color
    if ( present(fill_color) ) my_fill_color = fill_color
    if ( present(depth) ) my_depth = depth
    if ( present(area_fill) ) my_area_fill = area_fill
    if ( present(style_val) ) my_style_val = style_val
    if ( present(join_style) ) my_join_style = join_style
    if ( present(cap_style) ) my_cap_style = cap_style
    if ( present(radius) ) my_radius = radius
    if ( present(forward_arrow) ) my_forward_arrow = 1
    if ( present(backward_arrow) ) my_backward_arrow = 1
    if ( present(unit) ) my_unit = unit

    if ( my_unit == 0 ) then
      write ( *, * ) 2, sub, my_style, my_thick, my_pen_color, &
        & my_fill_color, my_fill_color, my_depth, -1, my_area_fill, &
        & my_style_val, my_join_style, my_cap_style, my_radius, &
        & my_forward_arrow, my_backward_arrow, size(points,2)
      if ( present(forward_arrow) ) write ( *, * ) forward_arrow
      if ( present(backward_arrow) ) write ( *, * ) backward_arrow
      write ( *, * ) points
    else
      write ( unit, * ) 2, sub, my_style, my_thick, my_pen_color, &
        & my_fill_color, my_fill_color, my_depth, -1, my_area_fill, &
        & my_style_val, my_join_style, my_cap_style, my_radius, &
        & my_forward_arrow, my_backward_arrow, size(points,2)
      if ( present(forward_arrow) ) write ( unit, * ) forward_arrow
      if ( present(backward_arrow) ) write ( unit, * ) backward_arrow
      write ( unit, * ) points
    end if

  end subroutine WritePoly

end module WriteFig
