rgbpix: buffered write un production

This commit is contained in:
tTh 2024-01-17 01:13:49 +01:00
parent 4c13892c9d
commit 2b7012667a
5 changed files with 76 additions and 17 deletions

View File

@ -1,7 +1,7 @@
# #
# * Fortraneries from tTh * # * Fortraneries from tTh *
# #
# Makefile for the general purpose moduls # Makefile for the general purpose modules
# #
GFOPT = -Wall -Wextra -g -I. GFOPT = -Wall -Wextra -g -I.

View File

@ -1,8 +1,5 @@
# General purpose modules # General purpose modules
## Compiler un module
Mmmmm...
## Modules disponibles ## Modules disponibles
@ -13,7 +10,9 @@ Write gray level 2d buffer (aka picture) to disk in the NetPNM format.
### pixrgb ### pixrgb
Write 8 bits RGB pictures to PNM format. Write 8 bits or 16 bits RGB pictures to PNM format.
**Warning!** The width of the picture MUST be a multiple of 4 !
### trials ### trials
@ -21,8 +20,16 @@ Experimental WIPs from hell.
### dummy ### dummy
A "do nothing" useless module. But you cas use it to fool an optimizing A "do nothing" useless module.
compiler, or have a sane place to put a breakpoint with gdb But you cas use it to fool an optimizing compiler,
or have a sane place to put a breakpoint with gdb
## Compiler un module
You can use the same options as for a main program.
And when you use the module, you have to specify the paths
for the .mod and the .o to the linker.
See [Makefile](./Makefile) for an example.
## TODO ## TODO

View File

@ -11,8 +11,8 @@ program chkpixels
implicit none implicit none
write(0, *) "------ CHKPIXELS ------" write(0, *) "------ CHKPIXELS ------"
call test_spit_as(3) ! call test_spit_gray(3)
call test_spit_rgb(128, 222) call test_spit_rgb16(1100, 512)
STOP 'BECAUSE NO CPU AVAILABLE' STOP 'BECAUSE NO CPU AVAILABLE'
@ -21,7 +21,7 @@ contains
!- !-
! exerciser for the 'pixrgb' module ! exerciser for the 'pixrgb' module
!- !-
subroutine test_spit_rgb(sz, kg) subroutine test_spit_rgb16(sz, kg)
integer, intent(in) :: sz, kg integer, intent(in) :: sz, kg
type(t_pixrgb), allocatable :: pixrgb(:,:) type(t_pixrgb), allocatable :: pixrgb(:,:)
@ -30,15 +30,17 @@ contains
print *, "test spit rgb", sz print *, "test spit rgb", sz
allocate(pixrgb(sz, sz)) allocate(pixrgb(sz, sz))
call rgbpix_set_to_zero(pixrgb) call rgbpix_set_to_zero(pixrgb)
do ix=1, sz do ix=1, sz
do iy=1, sz do iy=1, sz
pixrgb(ix, iy)%r = ix pixrgb(ix, iy)%r = mod(ix * iy, 65000)
pixrgb(ix, iy)%g = mod(ix*iy, kg) if (ix.EQ.iy) pixrgb(ix, iy)%g = 65000
pixrgb(ix, iy)%b = iy pixrgb(ix, iy)%b = mod ((ix*iy) * 13, 65000)
end do end do
end do end do
call rgbpix_spit_as_pnm_8(pixrgb, "rgb8.pnm") call rgbpix_spit_as_pnm_16 (pixrgb, "current-rgb16.pnm")
call rgbpix_spit_as_pnm_16(pixrgb, "rgb16.pnm") call new_spit_rgb16 (pixrgb, "experiment-rgb16.pnm")
deallocate(pixrgb) deallocate(pixrgb)
end subroutine end subroutine

View File

@ -16,6 +16,8 @@ end type
contains contains
!------------------------------------------------------------------- !-------------------------------------------------------------------
!- !-
! try FORALL here
!-
subroutine rgbpix_set_to_zero(pic) subroutine rgbpix_set_to_zero(pic)
type(t_pixrgb), intent(out) :: pic(:,:) type(t_pixrgb), intent(out) :: pic(:,:)
integer :: ix, iy integer :: ix, iy
@ -88,7 +90,7 @@ end subroutine
!- !-
! CAUTION: there was NO out-of-bounds check ! ! CAUTION: there was NO out-of-bounds check !
!- !-
subroutine rgbpix_spit_as_pnm_16(pic, fname) subroutine rgbpix_spit_as_pnm_16_old(pic, fname)
type(t_pixrgb), intent(in) :: pic(:,:) type(t_pixrgb), intent(in) :: pic(:,:)
character (len=*), intent(in) :: fname character (len=*), intent(in) :: fname
@ -111,4 +113,51 @@ subroutine rgbpix_spit_as_pnm_16(pic, fname)
end subroutine end subroutine
!------------------------------------------------------------------- !-------------------------------------------------------------------
!-
! CAUTION: there was NO out-of-bounds check !
!-
subroutine rgbpix_spit_as_pnm_16(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, "(i0, 11(' ', 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 module end module

View File

@ -94,3 +94,4 @@ end subroutine
!------------------------------------------------------------------- !-------------------------------------------------------------------
end module end module