Prints a nicely formatted abort message box
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | message | |||
character(len=*), | intent(in) | :: | location | |||
integer, | intent(in) | :: | output_unit |
SUBROUTINE print_abort_message(message, location, output_unit)
!! Prints a nicely formatted abort message box
CHARACTER(LEN=*), INTENT(IN) :: message, location
INTEGER, INTENT(IN) :: output_unit
CHARACTER(LEN=*), PARAMETER :: img = " ___ "//" / \ "//" [ABORT] "//" \___/ "// &
" | "//" O/| "//" /| | "//" / \ "
INTEGER, PARAMETER :: img_height = 8, img_width = 9, screen_width = 80, &
txt_width = screen_width - img_width - 5
CHARACTER(LEN=screen_width) :: msg_line
INTEGER :: a, b, c, fill, i, img_start, indent, &
msg_height, msg_start
! count message lines
a = 1; b = -1; msg_height = 0
DO WHILE (b < LEN_TRIM(message))
b = next_linebreak(message, a, txt_width)
a = b + 1
msg_height = msg_height + 1
END DO
! calculate message and image starting lines
IF (img_height > msg_height) THEN
msg_start = (img_height - msg_height)/2 + 1
img_start = 1
ELSE
msg_start = 1
img_start = msg_height - img_height + 2
END IF
! print empty line
WRITE (UNIT=output_unit, FMT="(A)") ""
! print opening line
WRITE (UNIT=output_unit, FMT="(T2,A)") REPEAT("*", screen_width - 1)
! print body
a = 1; b = -1; c = 1
DO i = 1, MAX(img_height - 1, msg_height)
WRITE (UNIT=output_unit, FMT="(A)", advance='no') " *"
IF (i < img_start) THEN
WRITE (UNIT=output_unit, FMT="(A)", advance='no') REPEAT(" ", img_width)
ELSE
WRITE (UNIT=output_unit, FMT="(A)", advance='no') img(c:c + img_width - 1)
c = c + img_width
END IF
IF (i < msg_start) THEN
WRITE (UNIT=output_unit, FMT="(A)", advance='no') REPEAT(" ", txt_width + 2)
ELSE
b = next_linebreak(message, a, txt_width)
msg_line = message(a:b)
a = b + 1
fill = (txt_width - LEN_TRIM(msg_line))/2 + 1
indent = txt_width - LEN_TRIM(msg_line) - fill + 2
WRITE (UNIT=output_unit, FMT="(A)", advance='no') REPEAT(" ", indent)
WRITE (UNIT=output_unit, FMT="(A)", advance='no') TRIM(msg_line)
WRITE (UNIT=output_unit, FMT="(A)", advance='no') REPEAT(" ", fill)
END IF
WRITE (UNIT=output_unit, FMT="(A)", advance='yes') "*"
END DO
! print location line
WRITE (UNIT=output_unit, FMT="(A)", advance='no') " *"
WRITE (UNIT=output_unit, FMT="(A)", advance='no') img(c:c + img_width - 1)
indent = txt_width - LEN_TRIM(location) + 1
WRITE (UNIT=output_unit, FMT="(A)", advance='no') REPEAT(" ", indent)
WRITE (UNIT=output_unit, FMT="(A)", advance='no') TRIM(location)
WRITE (UNIT=output_unit, FMT="(A)", advance='yes') " *"
! print closing line
WRITE (UNIT=output_unit, FMT="(T2,A)") REPEAT("*", screen_width - 1)
! print empty line
WRITE (UNIT=output_unit, FMT="(A)") ""
END SUBROUTINE print_abort_message