print_ansi(3f) - [M_pixel:PRINT] print small pixel array as colored text on terminals and terminal emulators that obey ANSI escape sequences (LICENSE:PD)
definition:
subroutine print_ansi(filename)
character(len=*),intent(in) :: filename
This driver prints the pixmap as a simple array of ANSI terminal escape sequences. It assumes only single-digit colors are used. It is appropriate for inspecting small pixmaps.
FILENAME name of output file. If blank write to stdout.
Sample Program:
program demo_print_ansi
use M_pixel
implicit none
call prefsize(80,24)
call vinit()
call ortho2(0.0,80.0,0.0,24.0)
call linewidth(400)
call color(1)
call circle(12.0,12.0,6.0)
call color(2)
call circle(72.0,12.0,6.0)
call print_ansi()
call vexit()
end program demo_print_ansi
John S. Urban
Public Domain
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| character(len=*), | intent(in), | optional | :: | filename |
subroutine print_ansi(filename)
use,intrinsic :: iso_fortran_env, only : ERROR_UNIT, INPUT_UNIT, OUTPUT_UNIT
! ident_39="@(#) M_pixel print_ansi(3f) print pixel array as an ASCII block of text"
character(len=*),intent(in),optional :: filename
character(len=1024) :: message
integer :: iu,ios,i,j
if(present(filename))then ! if filename is present and not blank open specified filename else use stdout
if(filename.eq.'')then
iu=OUTPUT_UNIT
ios=0
else
open(file=trim(filename),newunit=iu,iostat=ios,iomsg=message,action='write')
if(ios.ne.0)then
write(ERROR_UNIT,'(*(a))',iostat=ios)'*P_print_ansi* OPEN ERROR:',trim(message)
endif
endif
else
iu=OUTPUT_UNIT
ios=0
endif
if(ios.eq.0)then
call if_init()
do i=0,size(P_pixel,dim=2)-1
do j=1,size(P_pixel,dim=1)
write(iu,'(*(g0))',iostat=ios,iomsg=message,advance='no')char(27),'[4',P_pixel(j,i),'m '
if(ios.ne.0)then
write(ERROR_UNIT,'(*(a))',iostat=ios)'*P_print_ansi* WRITE ERROR:',trim(message)
exit
endif
enddo
write(iu,'(*(g0))',iostat=ios,iomsg=message,advance='yes')char(27),'[0m'
enddo
endif
flush(unit=iu,iostat=ios)
if(iu.ne.OUTPUT_UNIT)then
close(unit=iu,iostat=ios)
endif
end subroutine print_ansi