Fortraneries/Modules/trials.f90

98 lines
2.3 KiB
Fortran
Raw Normal View History

!-
! This module try to write PNM complient files - ymmv
!-
module trials
2024-01-14 09:42:09 +01:00
use pixrgb
implicit none
2022-12-16 19:26:54 +01:00
contains
!-------------------------------------------------------------------
2024-01-10 11:11:34 +01:00
! please write the same thing for RGB 16bits pictures !
subroutine new_spit_gray(pic, fname)
integer, intent(in), dimension (:,:) :: pic
character (len=*), intent(in) :: fname
integer :: foo, io, ix, iy
integer :: buffer(8), ptr
! print *, "newspit a, largeur ", size(pic, 1), ubound(pic, 1)
! print *, "newspit a, hauteur ", size(pic, 2), ubound(pic, 2)
! print *, "newspit a, buffer ", size(buffer, 1)
open(newunit=io, file=fname)
write (io, '(a2)') "P2"
2024-01-10 11:11:34 +01:00
write (io, '("# new_spit_gray")')
write (io, '(i0," ",i0)') size(pic, 1), size(pic, 2)
write (io, '(i0)') 65535
buffer = 0
ptr = 1
do iy=1, ubound(pic, 2)
do ix=1, ubound(pic, 1)
foo = pic(ix, iy)
if (foo .GT. 65535) foo = 65535
buffer(ptr) = foo
ptr = ptr + 1
if (ptr .EQ. size(buffer, 1)+1) then
write(io, "(8(' ',i0))") buffer
ptr = 1
endif
enddo
enddo
close(io)
2024-01-14 09:42:09 +01:00
end subroutine
!-------------------------------------------------------------------
!-
! CAUTION: there was NO out-of-bounds check !
!-
subroutine new_spit_rgb16(pic, fname)
type(t_pixrgb), intent(in) :: pic(:,:)
character (len=*), intent(in) :: fname
integer :: io, ix, iy, ik
integer :: buffer(3*4), ptr
write(0, *) ">>> subroutine rgbpix_spit_as_pnm_16"
open(newunit=io, file=fname)
write (io, '(a2)') "P3"
! write (io, '("# rgbpix_spit_as_pnm_16")')
write (io, '(i0," ",i0)') size(pic, 1), size(pic, 2)
write (io, '(i0)') 65535
buffer = 0
ptr = 1
do iy=1, ubound(pic, 2)
do ix=1, ubound(pic, 1)
buffer(ptr) = pic(ix, iy)%r
buffer(ptr+1) = pic(ix, iy)%g
buffer(ptr+2) = pic(ix, iy)%b
ptr = ptr + 3
if (ptr .EQ. 13) then
write(io, "(12(' ', i0))") buffer
ptr = 1
endif
enddo ! write(io, *) " fin iy=", iy
enddo
! may be we have to flush the buffer ?
close(unit=io)
end subroutine
!-------------------------------------------------------------------
2024-01-10 11:11:34 +01:00
end module
2024-01-17 01:13:49 +01:00