centralized functionality for handling of colors

src/CLI.f90

@@ -71,10 +71,10 @@ subroutine CLI_init()
 
  ! http://patorjk.com/software/taag/#p=display&f=Lean&t=DAMASK%203
 #ifdef DEBUG
-  print'(a)', achar(27)//'[31m'
+  print'(a)', IO_color([255,0,0])
   print'(1x,a,/)', 'debug version - debug version - debug version - debug version - debug version'
 #else
-  print'(a)', achar(27)//'[1;94m'
+  print'(a)', IO_color([67,128,208])
 #endif
   print'(1x,a)', '    _/_/_/      _/_/    _/      _/    _/_/      _/_/_/  _/    _/    _/_/_/'
   print'(1x,a)', '   _/    _/  _/    _/  _/_/  _/_/  _/    _/  _/        _/  _/            _/'
@@ -89,7 +89,7 @@ subroutine CLI_init()
 #ifdef DEBUG
   print'(/,1x,a)', 'debug version - debug version - debug version - debug version - debug version'
 #endif
-  print'(a)', achar(27)//'[0m'
+  print'(a)', IO_color()
 
   print'(1x,a)', 'F. Roters et al., Computational Materials Science 158:420–478, 2019'
   print'(1x,a)', 'https://doi.org/10.1016/j.commatsci.2018.04.030'

src/IO.f90

@@ -13,6 +13,9 @@ module IO
   use prec
   use constants
   use misc
+#ifndef MARC4DAMASK
+  use system_routines
+#endif
 
 implicit none(type,external)
   private
@@ -42,6 +45,7 @@ module IO
     IO_strAsInt, &
     IO_strAsReal, &
     IO_strAsBool, &
+    IO_color, &
     IO_error, &
     IO_warning, &
     IO_STDOUT
@@ -433,6 +437,41 @@ logical function IO_strAsBool(str)
 end function IO_strAsBool
 
 
+!--------------------------------------------------------------------------------------------------
+!> @brief Set foreground and/or background color.
+!> @details Only active if unit is a TTY. Does nothing for MSC.Marc or when writing to log file.
+!> @details https://stackoverflow.com/questions/4842424
+!--------------------------------------------------------------------------------------------------
+function IO_color(fg,bg,unit)
+
+  character(len=:), allocatable :: IO_color
+  integer, intent(in), dimension(3), optional :: fg, bg
+  integer, intent(in), optional :: unit                                                             !< output unit (default STDOUT)
+
+  integer :: unit_
+
+
+  IO_color = ''
+
+#if !(defined(MARC4DAMASK) || defined(LOGFILE))
+  unit_ = misc_optional(unit,IO_STDOUT)
+  if (unit_ == IO_STDOUT .and. .not. STDOUT_isatty()) return
+  if (unit_ == IO_STDERR .and. .not. STDERR_isatty()) return
+
+  if (present(fg)) &
+    IO_color = IO_color//achar(27)//'[38;2;'//IO_intAsStr(fg(1))//';' &
+                                            //IO_intAsStr(fg(2))//';' &
+                                            //IO_intAsStr(fg(3))//'m'
+  if (present(bg)) &
+    IO_color = IO_color//achar(27)//'[48;2;'//IO_intAsStr(bg(1))//';' &
+                                            //IO_intAsStr(bg(2))//';' &
+                                            //IO_intAsStr(bg(3))//'m'
+
+  if (.not. present(fg) .and. .not. present(bg)) IO_color = achar(27)//'[0m'
+#endif
+
+end function IO_color
+
 
 !--------------------------------------------------------------------------------------------------
 !> @brief Write error statements and terminate the run with exit #9xxx.
@@ -731,8 +770,8 @@ subroutine panel(paneltype,ID,msg,ext_msg,label1,ID1,label2,ID2)
   if (present(ID1)) msg1 = msg1//' '//IO_intAsStr(ID1)
   if (present(ID2)) msg2 = msg2//' '//IO_intAsStr(ID2)
 
-  if (paneltype == 'error')   msg_ = achar(27)//'[31m'//trim(msg)//achar(27)//'[0m'
+  if (paneltype == 'error')   msg_ = IO_color([255,0,0],  unit=IO_STDERR)//trim(msg)//IO_color(unit=IO_STDERR)
-  if (paneltype == 'warning') msg_ = achar(27)//'[33m'//trim(msg)//achar(27)//'[0m'
+  if (paneltype == 'warning') msg_ = IO_color([255,255,0],unit=IO_STDERR)//trim(msg)//IO_color(unit=IO_STDERR)
   !$OMP CRITICAL (write2out)
   write(IO_STDERR,'(/,a)')                ' ┌'//DIVIDER//'┐'
   write(formatString,'(a,i2,a)') '(a,24x,a,1x,i0,',max(1,panelwidth-24-len_trim(paneltype)-1-len_trim(ID_)),'x,a)'