need more tests
This commit is contained in:
parent
3b4726fb2a
commit
4c13892c9d
@ -3,6 +3,8 @@
|
|||||||
!-
|
!-
|
||||||
module trials
|
module trials
|
||||||
|
|
||||||
|
use pixrgb
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
|
|
||||||
contains
|
contains
|
||||||
@ -45,6 +47,49 @@ subroutine new_spit_gray(pic, fname)
|
|||||||
|
|
||||||
close(io)
|
close(io)
|
||||||
|
|
||||||
|
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
|
end subroutine
|
||||||
!-------------------------------------------------------------------
|
!-------------------------------------------------------------------
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user