Merge branch '359-io_color' into 'development'

Resolve "IO_color"

Closes #359

See merge request damask/DAMASK!870

python/damask/util.py

@@ -930,8 +930,8 @@ class ProgressBar:
         self.time_start = self.time_last_update = _datetime.datetime.now()
         self.fraction_last = 0.0
 
-        _sys.stderr.write(f"{self.prefix} {'░'*self.bar_length}   0% ETA n/a")
+        if _sys.stdout.isatty():
-        _sys.stderr.flush()
+            _sys.stdout.write(f"{self.prefix} {'░'*self.bar_length}   0% ETA n/a")
 
     def update(self,
                iteration: int) -> None:
@@ -945,11 +945,10 @@ class ProgressBar:
             remaining_time = (_datetime.datetime.now() - self.time_start) \
                            * (self.total - (iteration+1)) / (iteration+1)
             remaining_time -= _datetime.timedelta(microseconds=remaining_time.microseconds)         # remove μs
-            _sys.stderr.write(f'\r{self.prefix} {bar} {fraction:>4.0%} ETA {remaining_time}')
+            if _sys.stdout.isatty():
-            _sys.stderr.flush()
+                _sys.stdout.write(f'\r{self.prefix} {bar} {fraction:>4.0%} ETA {remaining_time}')
 
         self.fraction_last = fraction
 
-        if iteration == self.total - 1:
+        if iteration == self.total - 1 and _sys.stdout.isatty():
-            _sys.stderr.write('\n')
+            _sys.stdout.write('\n')
-            _sys.stderr.flush()

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/C_routines.c

@@ -85,6 +85,20 @@ void inflate_c(const uLong *s_deflated, const uLong *s_inflated, const Byte defl
   }
 }
 
+
+int stdout_isatty_c(){
+  return isatty(STDOUT_FILENO);
+}
+
+int stderr_isatty_c(){
+  return isatty(STDERR_FILENO);
+}
+
+int stdin_isatty_c(){
+  return isatty(STDIN_FILENO);
+}
+
+
 #ifdef FYAML
 void to_flow_c(char **flow, long* length_flow, const char *mixed){
   struct fy_document *fyd = NULL;

src/IO.f90

@@ -13,8 +13,11 @@ module IO
   use prec
   use constants
   use misc
+#ifndef MARC4DAMASK
+  use system_routines
+#endif
 
-  implicit none(type,external)
+implicit none(type,external)
   private
 
   character(len=*), parameter, public :: &
@@ -42,6 +45,7 @@ module IO
     IO_strAsInt, &
     IO_strAsReal, &
     IO_strAsBool, &
+    IO_color, &
     IO_error, &
     IO_warning, &
     IO_STDOUT
@@ -433,6 +437,39 @@ logical function IO_strAsBool(str)
 end function IO_strAsBool
 
 
+!--------------------------------------------------------------------------------------------------
+!> @brief Return string to set foreground and/or background color.
+!> @details Only active if unit is a TTY. Does nothing for MSC.Marc. No color disables formatting.
+!> @details https://stackoverflow.com/questions/4842424
+!--------------------------------------------------------------------------------------------------
+function IO_color(fg,bg,unit)
+
+  character(len=:), allocatable :: IO_color
+  integer, intent(in), dimension(3), optional :: &
+    fg, &                                                                                           !< foreground color (8 bit RGB)
+    bg                                                                                              !< background color (8 bit RGB)
+  integer, intent(in), optional :: unit                                                             !< output unit (default STDOUT)
+
+
+  IO_color = ''
+
+#ifndef MARC4DAMASK
+  if (.not. isatty(misc_optional(unit,IO_STDOUT))) 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 +768,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)'

src/quit.f90

@@ -27,10 +27,10 @@ subroutine quit(stop_id)
   PetscErrorCode :: err_PETSc
 
 
-  call h5open_f(err_HDF5)                                                                           ! prevents error if not opened yet
+  call H5Open_f(err_HDF5)                                                                           ! prevents error if not opened yet
-  if (err_HDF5 < 0) write(ERROR_UNIT,'(a,i5)') ' Error in h5open_f ',err_HDF5
+  if (err_HDF5 < 0) write(ERROR_UNIT,'(a,i5)') ' Error in H5Open_f ',err_HDF5
-  call h5close_f(err_HDF5)
+  call H5Close_f(err_HDF5)
-  if (err_HDF5 < 0) write(ERROR_UNIT,'(a,i5)') ' Error in h5close_f ',err_HDF5
+  if (err_HDF5 < 0) write(ERROR_UNIT,'(a,i5)') ' Error in H5Close_f ',err_HDF5
 
   call PetscFinalize(err_PETSc)
 

src/system_routines.f90

@@ -4,9 +4,9 @@
 !--------------------------------------------------------------------------------------------------
 module system_routines
   use, intrinsic :: ISO_C_Binding
+  use, intrinsic :: ISO_fortran_env
 
   use prec
-  use IO
 
   implicit none(type,external)
   private
@@ -21,6 +21,7 @@ module system_routines
     signalint_C, &
     signalusr1_C, &
     signalusr2_C, &
+    isatty, &
     f_c_string, &
     free_C
 
@@ -30,8 +31,8 @@ module system_routines
 
     function setCWD_C(cwd) bind(C)
       use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR
-      implicit none(type,external)
 
+      implicit none(type,external)
       integer(C_INT) :: setCWD_C
       character(kind=C_CHAR), dimension(*), intent(in) :: cwd
     end function setCWD_C
@@ -39,8 +40,8 @@ module system_routines
     subroutine getCWD_C(cwd, stat) bind(C)
       use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR
       use prec
-      implicit none(type,external)
 
+      implicit none(type,external)
       character(kind=C_CHAR), dimension(pPathLen+1), intent(out) :: cwd                             ! NULL-terminated array
       integer(C_INT),                                intent(out) :: stat
     end subroutine getCWD_C
@@ -48,8 +49,8 @@ module system_routines
     subroutine getHostName_C(hostname, stat) bind(C)
       use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR
       use prec
-      implicit none(type,external)
 
+      implicit none(type,external)
       character(kind=C_CHAR), dimension(pSTRLEN+1), intent(out) :: hostname                         ! NULL-terminated array
       integer(C_INT),                               intent(out) :: stat
     end subroutine getHostName_C
@@ -57,40 +58,62 @@ module system_routines
     subroutine getUserName_C(username, stat) bind(C)
       use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR
       use prec
-      implicit none(type,external)
 
+      implicit none(type,external)
       character(kind=C_CHAR), dimension(pSTRLEN+1), intent(out) :: username                         ! NULL-terminated array
       integer(C_INT),                               intent(out) :: stat
     end subroutine getUserName_C
 
     subroutine signalint_C(handler) bind(C)
       use, intrinsic :: ISO_C_Binding, only: C_FUNPTR
-      implicit none(type,external)
 
+      implicit none(type,external)
       type(C_FUNPTR), intent(in), value :: handler
     end subroutine signalint_C
 
     subroutine signalusr1_C(handler) bind(C)
       use, intrinsic :: ISO_C_Binding, only: C_FUNPTR
-      implicit none(type,external)
 
+      implicit none(type,external)
       type(C_FUNPTR), intent(in), value :: handler
     end subroutine signalusr1_C
 
     subroutine signalusr2_C(handler) bind(C)
       use, intrinsic :: ISO_C_Binding, only: C_FUNPTR
-      implicit none(type,external)
 
+      implicit none(type,external)
       type(C_FUNPTR), intent(in), value :: handler
     end subroutine signalusr2_C
 
     subroutine free_C(ptr) bind(C,name='free')
       use, intrinsic :: ISO_C_Binding, only: C_PTR
-      implicit none(type,external)
 
+      implicit none(type,external)
       type(C_PTR), value :: ptr
     end subroutine free_C
 
+    function stdout_isatty_C() bind(C)
+      use, intrinsic :: ISO_C_Binding, only: C_INT
+
+      implicit none(type,external)
+      integer(C_INT) :: stdout_isatty_C
+    end function stdout_isatty_C
+
+    function stderr_isatty_C() bind(C)
+      use, intrinsic :: ISO_C_Binding, only: C_INT
+
+      implicit none(type,external)
+      integer(C_INT) :: stderr_isatty_C
+    end function stderr_isatty_C
+
+    function stdin_isatty_C() bind(C)
+      use, intrinsic :: ISO_C_Binding, only: C_INT
+
+      implicit none(type,external)
+      integer(C_INT) :: stdin_isatty_C
+    end function stdin_isatty_C
+
+
   end interface
 
 contains
@@ -101,7 +124,7 @@ contains
 !--------------------------------------------------------------------------------------------------
 subroutine system_routines_init()
 
-  print'(/,1x,a)', '<<<+-  system_routines init  -+>>>'; flush(IO_STDOUT)
+  print'(/,1x,a)', '<<<+-  system_routines init  -+>>>'; flush(OUTPUT_UNIT)
 
   call system_routines_selfTest()
 
@@ -229,6 +252,31 @@ pure function f_c_string(f_string) result(c_string)
 end function f_c_string
 
 
+!--------------------------------------------------------------------------------------------------
+!> @brief Test whether a file descriptor refers to a terminal.
+!> @detail A terminal is neither a file nor a redirected STDOUT/STDERR/STDIN.
+!--------------------------------------------------------------------------------------------------
+logical function isatty(unit)
+
+  integer, intent(in) :: unit
+
+
+  select case(unit)
+#ifndef LOGFILE
+    case (OUTPUT_UNIT)
+      isatty = stdout_isatty_C()==1
+    case (ERROR_UNIT)
+      isatty = stderr_isatty_C()==1
+#endif
+    case (INPUT_UNIT)
+      isatty = stdin_isatty_C()==1
+    case default
+      isatty = .false.
+  end select
+
+end function isatty
+
+
 !--------------------------------------------------------------------------------------------------
 !> @brief Check correctness of some system_routine functions.
 !--------------------------------------------------------------------------------------------------