! vt_plotd.f90
!
! simple random write to screen, and draw shapes on VT100 type terminal
!
! 11/5/96 JSS Fortran 90 version from .ADA, .CPP, .C versions
! students to add  DRAW_LINE  subroutine

module vt_plotd
  implicit none

  ! center of screen is 0.0,0.0
  ! X positive is left across screen, Y positive is up screen
  ! limits :  -39.0 <= X <= 39.0      -11.0 <= Y <= 11.0

  integer, parameter, public :: OUTLINE = 1       ! just draw outline
  integer, parameter, public :: FILL = 2          ! fill in figure
  integer, parameter, public :: CLEAR = 3         ! erase outline or text
  integer, parameter, public :: CLEAR_FILL = 4    ! erase filled shape
  integer, parameter, public :: BOLD = 5          ! make bold, text or fill

  public PRINT, PUT_STRING, BOLD_ON, BOLD_OFF,            &
         INITIALIZE, PLOT_CHAR, DRAW_CIRCLE, WRITE_TEXT,  &
         DRAW_ELIPSE, DRAW_RECTANGLE,                     &
         delay

private

  integer, parameter :: ROW_OFFSET = 11
  integer, parameter :: COLUMN_OFFSET = 40
  real, parameter    :: TWO_PI = 6.26     ! intentionally small
  character (len=1), parameter :: ESC = achar(27)

contains

  subroutine BOLD_ON
    character (len=4) :: on
    on = ESC // "[1m"
    print *, on
  end subroutine BOLD_ON

  subroutine BOLD_OFF
    character (len=4) :: off
    off = ESC // "[0m"
    print *, off
  end subroutine BOLD_OFF

  function STRIP(N) result(S)
    integer, intent(in) :: N     ! a row or column in integer
    character (len=2) :: S
    if (N >= 10) then
      write(S,fmt="(i2)")N
    else
      write(S,fmt="(i1,1h )")N
    end if 
  end function STRIP


  subroutine PUT_STRING(LINE, COLUMN, PLOT_STR)
    integer, intent(in) :: LINE      ! from line 1 to 23
    integer, intent(in) :: COLUMN    ! from column 1 to 79
    character (len=*), intent(in) :: PLOT_STR
    integer :: L
    integer :: C
    character (len=80) :: msg
    integer :: actual_length

    L = LINE
    C = COLUMN
    if (L < 1) then
      L = 1
    else if (L > 23) then
      L = 23
    end if
    if (C < 1) then
      C = 1
    else if (C + len(PLOT_STR) > 80) then
      C = 80 - len(PLOT_STR)
    end if
    msg = ESC // '[' //  &
                  trim(STRIP(24-L)) // ';' // &
                  trim(STRIP(C)) // 'f' // PLOT_STR
    actual_length = 4 + len(PLOT_STR) + len(trim(STRIP(24-L))) + &
                                        len(trim(STRIP(C)))
    print *, msg(1:actual_length)
  end subroutine PUT_STRING

  subroutine INITIALIZE
    character (len=4) :: clear
    clear = ESC // "[2J"         ! clear the screen
    print *, clear
  end subroutine INITIALIZE

  subroutine PRINT
    print *, achar(27) // "[1;1f" ! keep cursor out of way and cause
                                  ! update by flushing output buffer
  end subroutine PRINT

  function PLOT_CHAR( kind ) result(draw_char)
    integer, intent(in) :: kind
    character (len=1) :: draw_char 
  
    select case (kind)
      case (OUTLINE)
        draw_char = "*"
      case (FILL)
        draw_char = "*"
      case (BOLD)
        draw_char = "*"
      case default
        draw_char = " "
    end select
  end function PLOT_CHAR

  subroutine DRAW_CIRCLE ( X, Y, R, kind)
    real, intent(in)    :: X, Y   ! position of center
    real, intent(in)    :: R      ! radius
    integer, intent(in), optional :: kind   ! default OUTLINE
    integer :: my_kind
    integer :: row, col
    real :: T
    real :: step
    real :: r_temp
    character (len=1) :: draw_char

    !       generate a circle using sine and cosine
    if (present(kind))then
      my_kind = kind
    else
      my_kind = OUTLINE
    end if
    draw_char = PLOT_CHAR(my_kind)
    if (my_kind == BOLD) call BOLD_ON
    r_temp = R
    T = 0.0
    if (r_temp > 11.0) r_temp = 11.0   ! limit size to screen
    if (r_temp < 0.1) r_temp = 0.1
    step = 0.45/(TWO_PI*r_temp)
    do while (T < TWO_PI)
      col = int( X + sin(T) * r_temp)+COLUMN_OFFSET
      row = int( Y + cos(T) * r_temp)+ROW_OFFSET
      call PUT_STRING(row, col, draw_char)
      T = T + step
    end do
    if (my_kind == FILL .or. my_kind == CLEAR_FILL) then
      do while (r_temp > 0.95)
        r_temp = r_temp - 0.95
        step = 0.45/(TWO_PI*r_temp)
        T = 0.0
        do while (T < TWO_PI)
          col = int( X + sin(T) * r_temp)+COLUMN_OFFSET
          row = int( Y + cos(T) * r_temp)+ROW_OFFSET
          call PUT_STRING(row, col, draw_char)
          T = T + step
        end do
      end do
    end if
    if (my_kind == BOLD) call BOLD_OFF 
  end subroutine DRAW_CIRCLE

  subroutine DRAW_ELIPSE ( X, Y, XR, YR, kind)
    real, intent(in)    :: X, Y    ! position of center
    real, intent(in)    :: XR, YR  ! X radius and Y radius
    integer, intent(in), optional :: kind   ! default OUTLINE
    integer :: my_kind
    integer :: row, col
    real :: T
    real :: step
    real :: XR_TEMP
    real :: YR_TEMP
    character (len=1) :: draw_char

    !       generate an elipse using sine and cosine
    if (present(kind))then
      my_kind = kind
    else
      my_kind = OUTLINE
    end if
    draw_char = PLOT_CHAR(my_kind)
    if (my_kind == BOLD) call BOLD_ON
    XR_TEMP = XR
    YR_TEMP = YR
    if (XR_TEMP > 39.0) XR_TEMP = 39.0
    if (XR_TEMP < 0.95) XR_TEMP = 0.95
    if (YR_TEMP > 11.0) YR_TEMP = 11.0
    if (YR_TEMP < 0.95) YR_TEMP = 0.95
    step = 0.45/(TWO_PI*(XR_TEMP+YR_TEMP))
    T = 0.0
    do while (T < TWO_PI)
      col = int( X + sin(T) * XR_TEMP)+COLUMN_OFFSET
      row = int( Y + cos(T) * YR_TEMP)+ROW_OFFSET
      call PUT_STRING(row, col, draw_char)
      T = T + step
    end do
    if (my_kind == FILL .or. my_kind == CLEAR_FILL) then
      do while (YR_TEMP > 0.95 .and. XR_TEMP > 0.95)
        YR_TEMP = YR_TEMP - 0.95
        XR_TEMP = XR_TEMP - 0.95
        step = 0.45/(TWO_PI*(XR_TEMP+YR_TEMP))
        T = 0.0
        do while (T < TWO_PI)
          col = int( X + sin(T) * XR_TEMP)+COLUMN_OFFSET
          row = int( Y + cos(T) * YR_TEMP)+ROW_OFFSET
          call PUT_STRING(row, col, draw_char)
          T = T + step
        end do
      end do
    end if
    if (my_kind == BOLD) call BOLD_OFF  
  end subroutine DRAW_ELIPSE

  subroutine DRAW_RECTANGLE ( X, Y, W, H, kind)
    real, intent(in)    :: X, Y   ! position of lower left corner
    real, intent(in)    :: W, H   ! width and height
    integer, intent(in), optional :: kind   ! default OUTLINE
    integer :: my_kind
    integer :: row, col
    real :: T
    real :: h_temp
    character (len=1) :: draw_char

    if (present(kind))then
      my_kind = kind
    else
      my_kind = OUTLINE
    end if
    draw_char = PLOT_CHAR(my_kind)
    if (my_kind == BOLD) call BOLD_ON
    h_temp = H
    if (H_TEMP > 22.0) H_TEMP = 22.0
    if (H_TEMP < 1.0) H_TEMP = 1.0
    T = 0.0
    do while (T < W) 
      col = int(X - W/2.0 + T)+COLUMN_OFFSET 
      row = int(Y + H_TEMP/2.0)+ROW_OFFSET
      call PUT_STRING(row, col, draw_char)
      row = int(Y - H_TEMP/2.0)+ROW_OFFSET
      call PUT_STRING(row, col, draw_char)
      T = T + 0.95
    end do
    if (.not. (my_kind == FILL .or. my_kind == CLEAR_FILL)) then
      ! draw sides
      T = 0.0
      do while (T < H)
        col = int(X + W/2.0)+COLUMN_OFFSET 
        row = int(Y - H_TEMP/2.0 + T)+ROW_OFFSET
        call PUT_STRING(row, col, draw_char)
        col = int(X - W/2.0)+COLUMN_OFFSET 
        call PUT_STRING(row, col, draw_char)
        T = T + 0.95
      end do
    else                               ! fill it
      do while (H_TEMP > 0.95)
        H_TEMP = H_TEMP - 0.95
        T = 0.0
        do while (T < W)
          col = int(X - W/2.0 + T)+COLUMN_OFFSET 
          row = int(Y + H_TEMP/2.0)+ROW_OFFSET
          call PUT_STRING(row, col, draw_char)
          row = int(Y - H_TEMP/2.0)+ROW_OFFSET
          call PUT_STRING(row, col, draw_char)
          T = T + 0.95
        end do
      end do
    end if
    if (my_kind == BOLD) call BOLD_OFF 
  end subroutine DRAW_RECTANGLE

!  subroutine DRAW_LINE ( X1, Y1, X2, Y2, kind)
!       *** homework goes here ***
!  end subroutine DRAW_LINE


  subroutine WRITE_TEXT ( X, Y, TEXT, kind)
    real, intent(in) :: X, Y
    character (len=*), intent(in) :: TEXT
    integer, intent(in), optional :: kind
    integer :: my_kind
    integer :: row, col

    if (present(kind))then
      my_kind = kind
    else
      my_kind = OUTLINE
    end if
    if (my_kind == BOLD) call BOLD_ON
    row = int(Y)+ROW_OFFSET
    col = int(X)+COLUMN_OFFSET
    if (my_kind == CLEAR .or. my_kind == CLEAR_FILL) then
      call PUT_STRING(row, col, repeat(" ",len(TEXT)))
    else
      call PUT_STRING(row, col, TEXT)
    end if
    if (my_kind == BOLD) call BOLD_OFF 
  end subroutine WRITE_TEXT

  subroutine delay(X)
    real, intent(in) :: X
    real :: start
    real :: now
    integer :: count, count_rate, count_max

    call system_clock(count, count_rate, count_max)
    if (count == -huge(0)) return              ! no clock
    start = real(count)/real(count_rate)

    do                                         ! will not work for count>
                                               ! count max
      call system_clock(count, count_rate, count_max)
      now = real(count)/real(count_rate)
      if (now-start > X) exit
    end do

  end subroutine delay

end module vt_plotd