42 lines
		
	
	
		
			1.0 KiB
		
	
	
	
		
			Fortran
		
	
	
	
	
	
			
		
		
	
	
			42 lines
		
	
	
		
			1.0 KiB
		
	
	
	
		
			Fortran
		
	
	
	
	
	
| !-
 | |
| !	This module try to write PGM complient gray level files
 | |
| !-
 | |
| module pixrgb
 | |
|     implicit none
 | |
| !-----------------------------------------------------------------------
 | |
| !-
 | |
| !      definition of structures
 | |
| !-
 | |
| type t_pixrgb
 | |
|   integer           :: r, g, b
 | |
|   integer           :: alpha = 0
 | |
| end type
 | |
| !-------------------------------------------------------------------
 | |
| contains
 | |
| !-------------------------------------------------------------------
 | |
| !-
 | |
| subroutine rgbpix_spit_as_pnm(pic, fname)
 | |
| 
 | |
|   type(t_pixrgb), intent(in)       ::  pic(:,:)
 | |
|   character (len=*), intent(in)    ::  fname
 | |
| 
 | |
|   integer                               ::  io, ix, iy
 | |
| 
 | |
|   open(newunit=io, file=fname)
 | |
|   write (io, '(a2)') "P3"
 | |
|   write (io, '("# spit_rgb_pnm")')
 | |
|   write (io, '(i0," ",i0)')  size(pic, 1), size(pic, 2)
 | |
|   write (io, '(i0)') 255
 | |
| 
 | |
|   do iy=1, ubound(pic, 2)
 | |
|     do ix=1, ubound(pic, 1)
 | |
| 
 | |
|     write(io, "(3I7)") pic(ix, iy)%r, pic(ix, iy)%g, pic(ix, iy)%b
 | |
| 
 | |
|     enddo
 | |
|   enddo
 | |
|   close(unit=io)
 | |
| 
 | |
| end subroutine
 | |
| !-------------------------------------------------------------------
 | |
| end module | 
