rgbpix: buffered write un production
This commit is contained in:
parent
4c13892c9d
commit
2b7012667a
@ -1,7 +1,7 @@
|
||||
#
|
||||
# * Fortraneries from tTh *
|
||||
#
|
||||
# Makefile for the general purpose moduls
|
||||
# Makefile for the general purpose modules
|
||||
#
|
||||
|
||||
GFOPT = -Wall -Wextra -g -I.
|
||||
|
@ -1,8 +1,5 @@
|
||||
# General purpose modules
|
||||
|
||||
## Compiler un module
|
||||
|
||||
Mmmmm...
|
||||
|
||||
## Modules disponibles
|
||||
|
||||
@ -13,7 +10,9 @@ Write gray level 2d buffer (aka picture) to disk in the NetPNM format.
|
||||
|
||||
### 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
|
||||
|
||||
@ -21,8 +20,16 @@ Experimental WIPs from hell.
|
||||
|
||||
### dummy
|
||||
|
||||
A "do nothing" useless module. But you cas use it to fool an optimizing
|
||||
compiler, or have a sane place to put a breakpoint with gdb
|
||||
A "do nothing" useless module.
|
||||
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
|
||||
|
||||
|
@ -11,8 +11,8 @@ program chkpixels
|
||||
implicit none
|
||||
|
||||
write(0, *) "------ CHKPIXELS ------"
|
||||
call test_spit_as(3)
|
||||
call test_spit_rgb(128, 222)
|
||||
! call test_spit_gray(3)
|
||||
call test_spit_rgb16(1100, 512)
|
||||
|
||||
STOP 'BECAUSE NO CPU AVAILABLE'
|
||||
|
||||
@ -21,7 +21,7 @@ contains
|
||||
!-
|
||||
! exerciser for the 'pixrgb' module
|
||||
!-
|
||||
subroutine test_spit_rgb(sz, kg)
|
||||
subroutine test_spit_rgb16(sz, kg)
|
||||
integer, intent(in) :: sz, kg
|
||||
|
||||
type(t_pixrgb), allocatable :: pixrgb(:,:)
|
||||
@ -30,15 +30,17 @@ contains
|
||||
print *, "test spit rgb", sz
|
||||
allocate(pixrgb(sz, sz))
|
||||
call rgbpix_set_to_zero(pixrgb)
|
||||
|
||||
do ix=1, sz
|
||||
do iy=1, sz
|
||||
pixrgb(ix, iy)%r = ix
|
||||
pixrgb(ix, iy)%g = mod(ix*iy, kg)
|
||||
pixrgb(ix, iy)%b = iy
|
||||
pixrgb(ix, iy)%r = mod(ix * iy, 65000)
|
||||
if (ix.EQ.iy) pixrgb(ix, iy)%g = 65000
|
||||
pixrgb(ix, iy)%b = mod ((ix*iy) * 13, 65000)
|
||||
end do
|
||||
end do
|
||||
call rgbpix_spit_as_pnm_8(pixrgb, "rgb8.pnm")
|
||||
call rgbpix_spit_as_pnm_16(pixrgb, "rgb16.pnm")
|
||||
call rgbpix_spit_as_pnm_16 (pixrgb, "current-rgb16.pnm")
|
||||
call new_spit_rgb16 (pixrgb, "experiment-rgb16.pnm")
|
||||
|
||||
deallocate(pixrgb)
|
||||
|
||||
end subroutine
|
||||
|
@ -16,6 +16,8 @@ end type
|
||||
contains
|
||||
!-------------------------------------------------------------------
|
||||
!-
|
||||
! try FORALL here
|
||||
!-
|
||||
subroutine rgbpix_set_to_zero(pic)
|
||||
type(t_pixrgb), intent(out) :: pic(:,:)
|
||||
integer :: ix, iy
|
||||
@ -88,7 +90,7 @@ end subroutine
|
||||
!-
|
||||
! 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(:,:)
|
||||
character (len=*), intent(in) :: fname
|
||||
@ -111,4 +113,51 @@ subroutine rgbpix_spit_as_pnm_16(pic, fname)
|
||||
|
||||
end subroutine
|
||||
!-------------------------------------------------------------------
|
||||
end module
|
||||
!-
|
||||
! 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
|
||||
|
||||
|
||||
|
@ -94,3 +94,4 @@ end subroutine
|
||||
!-------------------------------------------------------------------
|
||||
|
||||
end module
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user