module shape_module

  type shape_type
    integer, private :: x_ = 0
    integer, private :: y_ = 0

  contains
    procedure, pass(this) :: getx
    procedure, pass(this) :: gety
    procedure, pass(this) :: setx
    procedure, pass(this) :: sety
    procedure, pass(this) :: moveto
    procedure, pass(this) :: draw
  end type shape_type

  interface shape_type
    module procedure shape_type_constructor
  end interface

  interface assignment (=)
    module procedure generic_shape_assign
  end interface

contains

  type (shape_type) function shape_type_constructor(x,y)
    implicit none
    integer, intent (in) :: x
    integer, intent (in) :: y

    shape_type_constructor%x_ = x
    shape_type_constructor%y_ = y
  end function shape_type_constructor

  integer function getx(this)
    implicit none

    class (shape_type), intent (in) :: this
    getx = this%x_
  end function getx

  integer function gety(this)
    implicit none

    class (shape_type), intent (in) :: this
    gety = this%y_
  end function gety

  subroutine setx(this,x)
    implicit none

    class (shape_type), intent (inout) :: this
    integer, intent (in) :: x
    this%x_ = x
  end subroutine setx

  subroutine sety(this,y)
    implicit none

    class (shape_type), intent (inout) :: this
    integer, intent (in) :: y
    this%y_ = y
  end subroutine sety

  subroutine moveto(this,newx,newy)
    implicit none

    class (shape_type), intent (inout) :: this
    integer, intent (in) :: newx
    integer, intent (in) :: newy
    this%x_ = newx
    this%y_ = newy
  end subroutine moveto

  subroutine draw(this)
    implicit none

    class (shape_type), intent (in) :: this

    print *, ' x = ', this%x_
    print *, ' y = ', this%y_
  end subroutine draw

  subroutine generic_shape_assign(lhs,rhs)
    implicit none

    class (shape_type), intent (out), allocatable :: lhs
    class (shape_type), intent (in) :: rhs

    allocate (lhs,source=rhs)
  end subroutine generic_shape_assign

end module shape_module